Excel VBA loop through specific sheets with subloop - vba

I'm trying to set up a VBA loop function that will iterate through a number of specific sheets, conducting a single nested-loop within each sheet. The nested loop is a sumif function, and I need to store this in sumHACC until each sheet has been looped through, with the final value (sum of each sumif) to be entered into a single cell.
The nested loop is being used on its own under a different if condition (see under 'ALL OTHER FUNDERS at the bottom), but I'm struggling to nest this within the loop to iterate it across different sheets - The double loop is in 'IF HACC IS SELECTED. The name of each sheet that needs to be looped through is stored in cells D6:D19, which I pull into HACCRange, and I'm trying to loop through these sheets with:
For Each HACC In HACCRange
Set calcTab1 = Sheets(HACC)
and this is where I receive a Type mismatch error. The code in this section isn't complete (i.e. no update to sumHACC) as I'm completely bamboozled as to how to make this work!
There is technically another loop on top of this (the sumif condition moves down a list (reference)), however this doesn't seem to be the problem. Any assistance would be greatly appreciated!
Sub FunderLevel()
Dim reference As Range
Dim Funder As String
Dim itemRef1 As Range
Dim itemRef3 As Range
Dim calcTab1 As Worksheet
Dim calcTab3 As Worksheet
Dim sumCol As Range
Dim printCalc As Range
Dim HACCRange As Range
Dim QCCRange As Range
i = 21
Set reference = Range("A21:A22")
Funder = Range("A10")
'IF HACC IS SELECTED
If Funder = "HACC" Then
sumHACC = 0
Set HACCRange = Sheets("Reference Sheet").Range("D6:D19")
For Each HACC In HACCRange
Set calcTab1 = Sheets(HACC)
Set itemRef1 = calcTab1.Range("A10:A500")
myCol = calcTab1.Rows(7).Find(What:="All", LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
With calcTab1
Set sumCol = calcTab1.Range(.Cells(10, myCol), .Cells(500, myCol))
End With
For Each Cell In reference
Set printCalc = Cells(i, 2)
printCalc = WorksheetFunction.SumIf(itemRef1, Cell, sumCol)
i = i + 1
Next Cell
Next HACC
'ALL OTHER FUNDERS
Else:
Set calcTab3 = Sheets(Funder)
Set itemRef3 = calcTab3.Range("A10:A500")
myCol = calcTab3.Rows(7).Find(What:="All", LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Colum
With calcTab3
Set sumCol = calcTab3.Range(.Cells(10, myCol), .Cells(500, myCol))
End With
For Each Cell In reference
Set printCalc = Cells(i, 2)
printCalc = WorksheetFunction.SumIf(itemRef3, Cell, sumCol)
i = i + 1
Next Cell
End If
End Sub

Try this:
For Each HACC In HACCRange.Cells
Set calcTab1 = Sheets(HACC.value)

Related

Using cell references for autoshape line

Have a sheet with a list of Cell references in two columns.
Trying to create a macro that pulls these into a range and uses the first cell in column A for the start point of an autoshape line and the second cell in column B as the end point of an autoshape line.
The script is working and doing what I want it to however at the end of execution I am getting "Subscript out of range error"
What am I doing wrong?
rng = Range("A1:B100")
Worksheets("Map").Activate
For Each row In rng
i = i + 1
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Range(rng(i, 1)).Left, Range(rng(i, 1)).Top, Range(rng(i, 2)).Left, Range(rng(i, 2)).Top).Select
Next row
Avoid select and activate, declare all the variables and loop only from the rows of the range:
Sub TestMe()
Dim rng As Range
Set rng = Worksheets("Map").Range("A1:B100")
Dim row As Range
Dim i As Long
For Each row In rng.Rows
i = i + 1
Worksheets("Map").Shapes.AddConnector msoConnectorStraight, _
row.Cells(i, 1).Left, _
row.Cells(i, 1).Top, _
row.Cells(i, 2).Left, _
row.Cells(i, 2).Top
Next row
End Sub
How to avoid using Select in Excel VBA
The Range("A1:B100") has no connection to Worksheets("Map") beyond a possible coincidence that Worksheets("Map") was the active worksheet. Provide proper parent worksheet reference.
You Set objects like ranges to their vars.
Don't Select the connectors you create; not in a loop, not ever.
with Worksheets("Map")
set rng = .Range("A1:B100")
For Each row In rng
i = i + 1
.Shapes.AddConnector msoConnectorStraight, _
.Range(rng(i, 1)).Left, .Range(rng(i, 1)).Top, _
.Range(rng(i, 2)).Left, .Range(rng(i, 2)).Top
Next row
end with

Return unique values which part match another criteria (Excel VBA)

I have a sheet of data on sheet1 which contains duplicates. On sheet 2 I have extracted a list of unique values with the Advanced Filter:
lr = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Data").Range("F2:F" & lr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=NewSh2.Range("B4"), Unique:=True
This works fine however I would like it to only return values which partly match another cell (This is a drop down box in K2 -
eg, if AA is selected in the box only values that start with AA are returned.)
I'm new to VBA and I'm not sure of the best way to go about doing this - (I had considered just deleting values which didn't match, which would create blanks, then to remove the blank rows - however I am concerned this would be a bit overkill and process heavy?) - is there a neater way to achieve this?
Thanks in advance!
Edit: Detail added.
So the dropdown in K2 has AA, BB, CC
The list of unique values looks something like:
AA01
AA02
AA03
BB02
BB03
AA05
CC01
CC02
CC03
CC05
BB04
When the drop down has selected AA I would like the list to only return:
AA01
AA02
AA03
AA05
Here's one way, using a dictionary:
Sub tgr()
Dim wb As Workbook
Dim wsData As Worksheet
Dim NewSh2 As Worksheet
Dim aFullList As Variant
Dim hUnqMatches As Object
Dim sMatch As String
Dim i As Long
Set wb = ActiveWorkbook
Set wsData = wb.Sheets("Data")
With wsData.Range("F2:F" & wsData.Cells(wsData.Rows.Count, "F").End(xlUp).Row)
If .Row < 2 Then Exit Sub 'No data
If .Cells.Count = 1 Then
ReDim aFullList(1 To 1, 1 To 1)
aFullList(1, 1) = .Value
Else
aFullList = .Value
End If
End With
sMatch = wsData.Range("K2").Value
Set hUnqMatches = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(aFullList, 1)
If Left(aFullList(i, 1), Len(sMatch)) = sMatch Then
If Not hUnqMatches.Exists(aFullList(i, 1)) Then hUnqMatches.Add aFullList(i, 1), aFullList(i, 1)
End If
Next i
If hUnqMatches.Count > 0 Then
On Error Resume Next
Set NewSh2 = wb.Sheets("Sheet2")
On Error GoTo 0
If NewSh2 Is Nothing Then
Set NewSh2 = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
NewSh2.Name = "Sheet2"
End If
NewSh2.Range("B4").Resize(hUnqMatches.Count).Value = Application.Transpose(hUnqMatches.Keys)
End If
End Sub
You can just add your cell K2 from sheet Data as a criteria to your autofilter. Simply add the following piece to your code:
Criteria1:= Sheets("Data").Range("K2").value
This combines with your code to:
lr = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Data").Range("F2:F" & lr).AdvancedFilter Action:=xlFilterCopy, Criteria1:= Sheets("Data").Range("K2").value CopyToRange:=NewSh2.Range("B4"), Unique:=True
For some background reading see: https://www.thespreadsheetguru.com/blog/2015/2/16/advanced-filters-with-vba-to-automate-filtering-on-and-out-specific-values

I need help looping an index/match that is inside an if statement using Excel VBA

I am trying to create a VBA macro to fill in cells that are empty in a range ("INV_Nums") without overwriting the cell if it contains data already. In order to accomplish this I am trying to use an if statement to check if the cell in question is blank...if it is not, then I want the loop to continue on to the next cell, however if it IS blank then I want to input the index(__,(match()) function into the cell.
I keep getting a "compile error: mismatch" on the True statement but I'm at a loss as to why my synatax would be wrong. Any help would be appreciated.
Here is my code:
Dim i As Integer
Dim Rng As Range
Dim ARwkb As Excel.Workbook
Dim ARwks As Excel.Worksheet
Dim Samwkb As Excel.Workbook
Dim Samwks As Excel.Worksheet
Set Samwkb = Excel.Workbooks("Samples - one sheet")
Set Samwks = Samwkb.Worksheets("samples shipment")
Set ARwkb = Excel.Workbooks("AR balance.xlsx")
Set ARwks = ARwkb.Worksheets("Total Trading")
Set Rng = Samwkb.Range("INV_Nums")
For i = 6 To Rng.Rows.Count + 6
If Range("AAi") = "" Is True Then
Range("AAi").Select
ActiveCell.FormulaR1C1 = _
"=INDEX('AR balance.xlsx'!AR_Invoice_Nums,MATCH(RC[-21],'AR
balance.xlsx'!AR_PL_Nums,0))"
End If
Next i
The problem is in how you are identifying the range and administering the criteria.
For i = 6 To Rng.Rows.Count + 6
If IsEmpty(Range("AA" & i)) Then
Range("AA" & i).FormulaR1C1 = _
"=INDEX('AR balance.xlsx'!AR_Invoice_Nums, MATCH(RC[-21],'AR balance.xlsx'!AR_PL_Nums, 0))"
End If
Next i
The .SpecialCells method can quickly determine the blank cells and an xlR1C1 formula can be used to insert all of the formulas at once..
...
with Samwkb.Range("INV_Nums")
.specialcells(xlcelltypeblanks).FormulaR1C1 = _
"=INDEX('AR balance.xlsx'!AR_Invoice_Nums, MATCH(RC[-21],'AR balance.xlsx'!AR_PL_Nums, 0))"
end with
...

Need to find an occurrence of a value in any beyond worksheet one and return the value of A:1 for each worksheet

I need to search all worksheets for the values in Worksheet one column A. The behavior should be similar to a CTRL-F find all selection. In A:1 of every worksheet is a name and if the value from column A is in that worksheet then A:1 will be returned. I do not need VLookup or HLookup. It might be doable with index and search combo, but I am not finding a good way to do that. I know I need an array search of some sort since I need to search everywhere. I have a solution that does not scale and is sloppy on the return. This is the formula I am currently using.
Column A is where the search values are pasted. Columns B-Z or however far is needed get the formula pasted in the first 200 rows which is the limit of the allowed search terms.
{=IF(OR($A2<>""),IF(OR($A2=Sheet26!$A$1:SZ$25000),Sheet26!A$1,"Not Found"),"")}
That is the formula for column Z and the sheet numbers are changed for each column that has a sheet. What I need to adjust this to is only having the formula in column B and it returning a concatenated value of all the names it found. There are lots of questions dealing with just one value or one range like this EXCEL: Need to find a value in a range of cells from another worksheet and return value from adjacent cell but nothing that actually answers what I need.
Currently the result I get is something like this.
A B C D E ...
Star Bob Not Found Ann Not Found
Light Bob Jill Not Found Not Found
378 Not Found Jill Not Found Not Found
What I would like to have is this
A B
Star Bob, Ann
Light Bob, Jill
378 Jill
How can I modify my formula to accomplish that?
Thanks
If you get tired of the formula approach, here is a VBA approach that should do what you describe.
It looks at column 1 on sheet1 to get a list of words to search for
read that list into a vba array (for speed)
for each item in the list, search each worksheet to see if the item exists
I added each item to a Dictionary, and then concatenated the results with commas, but you could also construct a string on the fly, to store in the second "column" of the array
After all is done, we write the results back to the worksheet.
It should be able to handle any reasonable number of worksheets and search terms
If necessary, you can limit the range to search on each worksheet; exclude certain worksheets from being searched; look at partial matches in a cell; select a case-sensitive search; etc.
If there are blank entries between the first and last search terms, I have excluded the search.
Option Explicit
Sub FindAllColA()
Dim WB As Workbook, WS As Worksheet
Dim WS1 As Worksheet
Dim D As Object
Dim V
Dim R As Range
Dim FirstRow As Long, LastRow As Long
Dim I As Long
Set D = CreateObject("scripting.dictionary")
Set WB = ThisWorkbook
Set WS1 = WB.Worksheets("Sheet1")
With WS1
If .Cells(1, 1) <> "" Then
FirstRow = 1
Else
FirstRow = .Cells(1, 1).End(xlDown).Row
End If
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'V will hold both search terms and the results
V = .Range(.Cells(FirstRow, 1), .Cells(LastRow, 1)).Resize(columnsize:=2)
End With
For I = 1 To UBound(V)
If Not V(I, 1) = "" Then
D.RemoveAll
For Each WS In WB.Worksheets
If Not WS.Name = WS1.Name Then
With WS
If Not .Cells.Find(what:=V(I, 1), LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False) Is Nothing Then
D.Add .Cells(1, 1).Text, .Cells(1, 1).Text
End If
End With
End If
Next WS
V(I, 2) = Join(D.Keys, ",")
Else
V(I, 2) = ""
End If
Next I
With WS1
Set R = .Range(.Cells(FirstRow, 1), .Cells(LastRow, 2))
R.EntireColumn.Clear
R = V
R.EntireColumn.AutoFit
End With
End Sub
Another way, would be an UDF which can be used in a wider range without any changes like:
Public Function ValString(search_term As String, cell_string As Variant, ParamArray ignored_sheets()) As Variant
Dim x As Variant
If TypeOf cell_string Is Range Then cell_string = cell_string.Address
If Not TypeOf Evaluate(cell_string) Is Range Then
ValString = CVErr(2023)
Exit Function
ElseIf Range(cell_string).Cells.Count > 1 Then
ValString = CVErr(2023)
Exit Function
End If
If IsMissing(ignored_sheets) Then
ignored_sheets = Array(Application.Caller.Parent.Name)
Else
For x = 0 To UBound(ignored_sheets)
If TypeOf ignored_sheets(x) Is Range Then
ignored_sheets(x) = ignored_sheets(x).Parent.Name
ElseIf TypeName(ignored_sheets(x)) = "String" Or IsNumeric(ignored_sheets(x)) Then
ignored_sheets(x) = Format(ignored_sheets(x), "#")
Else
ignored_sheets(x) = ""
End If
Next
End If
For Each x In ThisWorkbook.Worksheets
If IsError(Application.Match(x.Name, Array(ignored_sheets)(0), 0)) Then
If Not x.Cells.Find(search_term, , -4163, 1, , , True) Is Nothing Then
ValString = ValString & ", " & x.Range(cell_string).Value2
End If
End If
Next
If Len(ValString) Then
ValString = Mid(ValString, 3)
Else
ValString = CVErr(2042)
End If
End Function
Put the code in a Module and you can use it like a normal formula in your sheet.
Example:
=ValString(A1,"A1")
Or for your case:
=IFERROR(ValString(A1,"A1"),"Not Found")
Use: ValString([search_term],[cell_string],{[ignored_sheet1],[ignored_sheet2],...})
[search_term]: the string to look for
[cell_string]: the address of a cell as ref or string which you want to output if found
[ignored_sheets]: (optional) the sheet names as strings or a ref to them you want to ignore
If [ignored_sheets] is omitted the sheet you have the formula in will be ignored. To include all sheets in the workbook simply set it to ""
If nothing was found it will return #N/A! (which is good as you can catch this to set whatever output you want without changing the code)
If [cell_string] is not an address-string and/or goes for multiple cells, it will return #REF!
[ignored_sheets] is used as a list like =ValString(A1,"A1",Sheet1!A1,Sheet5!A1) or =ValString(A1,"A1","Sheet3","Sheet4","Sheet7","MyWhateverSheetName"). If used in the ref-way, you can rename the sheets and it will also in the formula. This is good if there is a summary sheet you do not want to check. But keep in mind: if used, the sheet with the formula itself, also needs to be included!
If you still have any questions, just ask ;)
try this UDF
Function findKeywords(findMe As String) As String
findKeywords = ""
Dim sheetToSkip As String
sheetToSkip = "Sheet1"
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Sheets
If sht.Name <> sheetToSkip And Len(findMe) > 0 Then ' do not look for blank cells
' note: LookAt:=xlWhole ... whole word LookAt:=xlPart ... partial
Dim aaa As Range
Set aaa = sht.Cells.Find( _
What:=findMe, _
After:=sht.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not aaa Is Nothing Then
If Len(findKeywords) = 0 Then
findKeywords = sht.Range("a1")
Else
findKeywords = findKeywords & ", " & sht.Range("a1")
End If
End If
End If
Next sht
' If Len(findKeywords) = 0 Then findKeywords = "Not Found" ' uncomment to return "Not Found" if desired
' Debug.Print findKeywords
End Function

Next Without For error in nested loop in Excel VBA

I am trying to figure out a way to run a Vlookup on a Cell in my "System File" by checking a table in a "New Data" File. HOWEVER, if there is an #N/A error, I want the cells' values to be unchanged. I've come up with the following, however, I keep getting a "Next without For" error. Is it possible to escape a nested For Next loop?
The tl;dr semantic version:
For i 1 to 10
For j 1 to 3
Something with .Cells(i,j)
Set range X = .Find(thing
If X = Nothing Then
Next j *** <THIS IS WHERE MY ERROR IS THROWN
Else
-Do Something with X-
End if
Next j
Next i
My more or less actual code is as follows:
Sub Thing()
Dim SysWS As Worksheet
Dim NewDataWS As Worksheet
Dim NDSKUs As Range ' This is set to the first column of the NewDataWS
Dim NDMonthsRow As Range ' This is set to the first row of the NewDataWS
Dim SKU2look4 As String, Month2look4 As String
Dim ifoundtheSKU As Range 'the result of finding SKU2look4 inside of NDSKUs range
Dim ifoundtheDate As Range 'the result of finding Month2look4 inside of NDMonthsRow range
Dim i As Integer, j As Integer
Dim workzone As Range 'The Cell being evaluated
For i = 2 To SysWS.UsedRange.Columns.Count
For j = 2 To SysWS.UsedRange.Rows.Count
Set workzone = SysWS.Cells(j, i)
SKU2look4 = SysWS.Cells(j, 1) 'SKUs are along the left column
Month2look4 = SysWS.Cells(1, i) 'Dates are along the top row
'1-Find the right Date Column for extraction
Set ifoundtheDate = NDMonthsRow.Find(What:=Month2look4, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If ifoundtheDate Is Nothing Then
Debug.Print (Month2look4 & " -Date NOT Found in New Date File")
******Next j******
Else
Debug.Print ("ifoundtheDate:" & ifoundtheDate.Address)
End If
'2-Find the row
Set ifoundtheSKU = NDSKUs.Find(What:=SKU2look4, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If ifoundtheSKU Is Nothing Then
Debug.Print (SKU2look4 & " Not Found in the New Data File")
*********Next j******
Else
Debug.Print ("ifoundtheSKU:" & ifoundtheSKU.Address)
End If
'Set the "workzone" cell's value to that of the found row offset by the found column
workzone = ifoundtheSKU.Offset(, (ifoundtheDate.Column - 1))
Next j
Next i
Of course the ***s are not actually in there. Any thoughts on how I can accomplish this?
Thanks in advance
For i = 1 to 10
For j = 1 to 3
Something with .Cells(i,j)
Set rngX = .Find(thing)
If Not rngX Is Nothing Then
Set rngY = .Find(thingelse)
If Not rngY Is Nothing Then
'something with rngX and rngY
End If
End if
Next j
Next i
Use
For i=1 to 10
For j=1 to 3
Something with .Cells(i,j)
Set range X = .Find(thing
If X = Nothing Then
Goto Nextj *** <THIS IS WHERE MY ERROR IS THROWN
Else
-Do Something with X-
End if
NextJ:
Next j
Next i
Exit For terminates the current for loop early (the inner one in your case).