Apply formatting to a range using array loop - VBA - excel

Using VBA i make to:
Set two ranges
Create an array of all ranges names
Loop the array in order to apply formatting to each range in the array
BUT on line .Interior.Color = vbRed
i receive the below error:
Run-time error '424': Object required
Code
Sub test()
Dim rng1 As Range, rng2 As Range
Dim strRanges As Variant
Dim i As Long
Set rng1 = Sheet1.Range("A1:D1")
Set rng2 = Sheet2.Range("C5:H5")
strRanges = Split("rng1,rng2", ",")
For i = LBound(strRanges) To UBound(strRanges)
With strRanges(i)
.Interior.Color = vbRed
End With
Next i
End Sub
i have already use:
With Range(strRanges(i))
instead of:
With strRanges(i)
without any luck!
Any help will appreciate.

You can do this in just one line if the ranges are in the same worksheet
Sheet1.Range("A1:D1,C5:H5").Interior.Color = vbRed
You can use union if the ranges are in the same worksheet
Dim rng1 As Range, rng2 As Range
Set rng1 = Sheet1.Range("A1:D1")
Set rng2 = Sheet1.Range("C5:H5")
Union(rng1, rng2).Interior.Color = vbRed
You can use real arrays for your ranges if they are in different worksheets
Sub test()
Dim rng(1 To 2) As Range
Set rng(1) = Sheet1.Range("A1:D1")
Set rng(2) = Sheet2.Range("C5:H5")
Dim i As Long
For i = LBound(rng) To UBound(rng)
With rng(i)
.Interior.Color = vbRed
End With
Next i
End Sub
If you don't have numbered range variable names then you can use another array:
Sub test()
Dim rngABC As Range, rngXYZ As Range
Set rngABC = Sheet1.Range("A1:D1")
Set rngXYZ = Sheet1.Range("C5:H5")
Dim ArrRng() As Variant
ArrRng = Array(rngABC, rngXYZ)
Dim rng As Variant
For Each rng In ArrRng
rng.Interior.Color = vbRed
Next rng
End Sub
Note that if you think you have to use numbered variable names like
Dim rng1 As Range, rng2 As Range
this always is a clear sign for using an array instead:
Dim rng(1 To 2) As Range
numbered variable names are a bad practice. Always choose meaningful names.

Related

Using for each with a worksheet reference

If ws below has both the range object and cell property:
dim ws as worksheet
set ws = sheets("sheet_1")
x = ws.range("A1")
x = ws.cells(1,1)
Why doesn't this work:
dim cel as range
dim rng as range
set rng = 'some range
for each cel in rng
ws.cel.value = "foo"
next
I want to ensure the right sheet is being referenced, and it seems logical to use ws as part of the cel reference to ensure the sheets reference is explicit.
You need to include how you set the rng, that's a vital bit of info to help troubleshoot. But generally, this should work:
Sub t()
Dim ws As Worksheet
Set ws = Sheets("sheet_1")
Dim cel As Range, rng As Range
Set rng = ws.Range("A1:C100")
For Each cel In rng.Cells
cel.Value = "foo"
Next
End Sub

VBA Adding another variable to a loop

I have a method CreatePage(). I would like to loop through variables to pass through the method. I have managed to get it working for one variable:
Sub main()
Dim rng As Range
Dim aSht As Worksheet
Set aSht = ThisWorkbook.Sheets("Sheet1")
For Each rng In aSht.Range("A5:A8")
CreatePage(rng)
Next rng
End Sub
I need it to loop as follows:
CreatePage("A5", "C6")
CreatePage("A6", "C7")
CreatePage("A7", "C8"), ...
I am stuck on how to pass through two variables. This is where I have got so far, but I don't think I'm going in the right direction:
Sub main()
Dim rng As Range
Dim rng2 As Range
Dim aSht As Worksheet
Dim bSht As Worksheet
Set aSht = ThisWorkbook.Sheets("Sheet1")
Set bSht = ThisWorkbook.Sheets("Sheet2")
For Each rng In aSht.Range("A5:A8")
For Each rng2 In bSht.Range("C6:C9")
CreatePage(rng,rng2)
Next rng, rng2
End Sub
I have adjusted CreatePage() to hold two variables. I'm puzzled on getting the second variable in the for loop. Can anyone help out?
A nested for loop won't help here. You need to loop one range only and pick the required cell from the other
Sub main()
Dim rng As Range
Dim rng2 As Range
Dim aSht As Worksheet
Dim bSht As Worksheet
Set aSht = ThisWorkbook.Sheets("Sheet1")
Set bSht = ThisWorkbook.Sheets("Sheet2")
Dim idx As Long
Set rng = aSht.Range("A5:A8")
Set rng2 = bSht.Range("C6:C9")
'You might want to add code here to check the size and shape of your ranges
For idx = 1 To rng.Cells.Count
CreatePage rng.Cells(idx), rng2.Cells(idx)
Next
End Sub
Just a simple change needed.
For Each rng In aSht.Range("A5:A8")
For Each rng2 In bSht.Range("C6:C9")
CreatePage rng, rng2
Next rng2
Next rng

Loop through the range VBA

Looking for a simple loop through the range (say column A range("A5:A15")) if there is a blank cell within that range I need the entire row/rows associated with the blank cell/cells to be hidden.
I was thinking of something like this to accommodate various ranges but get "type Mismatch" error. Any reasons why
Sub test()
Dim rng As Range, cell As Variant, ar As Variant
Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range
Dim MyArray(1 To 4) As Range
With ThisWorkbook.Worksheets("sheet1")
'Set MyArray = rng
Set MyArray(1) = Range("O8:O17")
Set MyArray(2) = Range("O55:O64")
Set MyArray(3) = Range("G37:G46")
Set MyArray(4) = Range("G89:G98")
'ar = Array(Rng1, Rng2, Rng3, Rng4)
'Set rng = .Range("O8:O17")
For Each cell In MyArray
If Len(cell.Value) < 1 Then
cell.EntireRow.Hidden = True
End If
Next cell
End With
End Sub
?
Something Like this:
You can put it in a subject:
For Each cell In Range("A5:A15")
If Len(cell.Value) < 1 Then
cell.EntireRow.Hidden = True
End If
Next
For Each cell In Range("A40:A55")
If Len(cell.Value) < 1 Then
cell.EntireRow.Hidden = True
End If
Next
New Answer :
Dim rng As Range, cell As Variant, ar As Variant
Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range
Dim MyArray(1 To 4) As Range
With ThisWorkbook.Worksheets("sheet1")
'Set MyArray = rng
Set MyArray(1) = Range("O8:O17")
Set MyArray(2) = Range("O55:O64")
Set MyArray(3) = Range("G37:G46")
Set MyArray(4) = Range("G89:G98")
'ar = Array(Rng1, Rng2, Rng3, Rng4)
'Set rng = .Range("O8:O17")
Dim i As Integer
For i = LBound(MyArray) To UBound(MyArray)
For Each cell In MyArray(i)
If Len(cell.Value) < 1 Then
cell.EntireRow.Hidden = True
End If
Next
Next
End With
Try:
Option Explicit
Sub test()
Dim rng As Range, cell As Range
With ThisWorkbook.Worksheets("Sheet1")
Set rng = .Range("A5:A15")
For Each cell In rng
If cell.Value = "" Then
.Rows(cell.Row).EntireRow.Hidden = True
End If
Next cell
End With
End Sub
This takes full advantage of the Excel VBA model. I'm guessing it's faster than the above but have not conducted performance tests.
Dim Cell As Range
For Each Cell In Range("A5:A15").SpecialCells(xlCellTypeBlanks)
Cell.EntireRow.Hidden = True
Next
Try the following
Option Explicit
Sub youcouldhaveatleasttriedtodosomethingyourself()
Dim r1 As Range, r2 As Range, c As Range, target As Range
With Workbooks(REF).Sheets(REF)
Set r1 = .Range("A1:A54")
Set r2 = .Range("F3:F32")
Set target = Application.Union(r1, r2)
For Each area In target.Areas
For Each c In area
If c.Value = vbNullString Then .Rows(c.Row).EntireRow.Hidden = True
Next c
Next area
End With
End Sub
Please note that I now have set two exemplifying ranges. You can always add more range variables to the Union function.

VBA Multiple value find and replace but also highlight replaced cells

I have a code that finds and replaces values in one sheet from a list in another sheet. However, I need this code to also highlight the cell, or flag it in some way so that it can be reviewed manually later. Any suggestions?
Here is the code:
Sub ReplaceValues()
Dim FandR As Worksheet
Dim PDH As Worksheet
Dim rng As Range, rngR As Range
Dim i As Long
Dim rngReplacement
Dim c As Range
Dim curVal As String
Set FandR = Sheets("Find and Replace")
Set PDH = ThisWorkbook.Sheets("Paste Data here")
i = PDH.Rows.Count
With PDH
Set rng = .Range("E1", .Range("E" & i).End(xlUp))
End With
With FandR
Set rngR = FandR.Range("H")
End With
For Each c In rngR
curVal = c.Value
c.Interior.Color = vbYellow
With rng
.Replace curVal, c.Offset(0, 1).Value, xlWhole, , True
End With
Next
End Sub

finding out what is the range with Endxl

First get the range of non-empty cells from Source workbook. Then select similar range of cells in Destination Workbook. How can this be achieved?
Full Code::
~~~~~~~~~~~
Public Sub ConvertTo_K()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Workbooks("Source.xls").Worksheets("Source").Range(Cells(2, "A"), Cells(Rows.Count, "A").End(xlUp).Resize(, 1))
Set rng2 = Workbooks("Destination.xls").Worksheets("Destination").Range(rng1.Address)
rng2.Value = Round(rng1.Value / 1000, 2)
'At this point, an error message of Type Mismatch pops up (Due to different ranges of rng1 and rng2). Do i have to use a loop? How to do that?
End Sub
Round(rng1.Value / 1000, 2) will not work because rng1 is a collection of ranges and can be accessed by rng1.Cells(1).value
rng1.Value is not valid.
You may loop thru each cell of rng2 and apply the round formula.
Public Sub ConvertTo_K()
Dim rng1 As Range
Dim rng2 As Range
Dim RoundRange As Range
Dim rngVal As Double
Dim SourceWkb As Workbook
Set SourceWkb = Workbooks("Source.xls")
Dim SourceSht As Worksheet
Set SourceSht = SourceWkb.Worksheets("Source")
With SourceSht
Set rng1 = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp).Resize(, 1))
End With
Dim DestinWkb As Workbook
Set DestinWkb = ThisWorkbook 'Workbooks("Destination.xls")
Dim DestinSht As Worksheet
Set DestinSht = DestinWkb.Worksheets("Destination")
With DestinSht
Set rng2 = .Range(rng1.Address)
End With
'rng2.Value = Round(rng1.Value / 1000, 2) This wont work
rng1.Copy rng2
For Each cell In rng2
cell.Value = Round(cell / 1000, 2)
Next
End Sub
If your rng1 works fine you could do it this way:
set rng2 = Workbooks("Destination.xls").Worksheets("Destination").Range(rng1.address)

Resources