I've got this idea - in a file I'm setting name and file to search and want the VBA to open that file, iterate through all the sheets, find the value that i search for and return some values at the same row. First at all I only find a method to search only in one column, but in my file the value could be in 5-6 columns. Does anyone has a idea how can I search in hole worksheet? Also I've got simple solution (the data that i searched for will be always in columns D, F, H, J...) and I'll just check the worst case and iterate overall unless find it, return my information, close the file and close the macros. So far this is my code:
Sub BTS()
Dim RowID As Integer
Dim SiteID As String
Dim objFindSiteID As Range
Dim objControllerData As Workbook
Dim WS As Worksheet
Dim lastRow As Long
Dim v As Range
SiteID = ThisWorkbook.Sheets("Sheet1").Range("A3").Value
If ThisWorkbook.Sheets("Sheet1").Range("B3").Value = "someValue" Then
Set objControllerData = Workbooks.Open("C:\Users\bla\bababa\bla.xls", True, True)
End If
For Each WS In objControllerData.Worksheets
lastRow = WS.Cells(WS.Rows.Count, "B").End(xlUp).Row
For I = 1 To lastRow
v = WS.Range("D" & I).Value
If v = SiteID Then
RowID = v.Row
MsgBox lastRow
MsgBox RowID
End If
Next I
Next WS
End Sub
Im almost done with that task, but there is a problem - Run time error 91. I already managed error 424, 1004, but this one is rly hard to find why occurred :/
remove Dim v As Range, you give him a value, not a range.
or, keep the range, and remove .Value at the end of the equal line. then get the value to another primitive, like myValue = v.Value
Related
As a learning exercise & possible use in future code I have created my first Excel VBA function to return the activecell row number in any Excel Table (as opposed to the sheet itself) . Essentially it simply finds the active row in the sheet, then finds the row number of the table header which is then subtracted from the cell row number to return the row number of the table which can then be used in subsequent code. However, while it works, it dosen't look the most efficient Can anyone improve it?
Sub TableRow()
Dim LORow As Integer
Dim TbleCell As Range
Set TbleCell = Activecell
Call FuncTableRow(TbleCell, LORow)
MsgBox LORow
End Sub
Public Function FuncTableRow(ByRef TbleCell As Range, LORow As Integer) As Range
Dim LOName As String
Dim LOHeaderRow, Row As Integer
LOName = Activecell.ListObject.Name
Row = Activecell.Row
LOHeaderRow = ActiveSheet.ListObjects(LOName).HeaderRowRange.Row
LORow = Row - LOHeaderRow
Debug.Print (LORow)
End Function
This question will probably get closed for not being specific enough but the most obvious item (to me) is your usage of a custom function. Your function is not actually returning anything, it's only running a debug print. To have your function actually return the row number, you would set it as a type Long (not integer) and include the function name = to the number.
I didn't actually test your function but assuming LORow is dubug printing the proper answer then it should work like this:
Public Function FuncTableRow(ByRef TbleCell As Range, LORow As Integer) As Long
Dim LOName As String
Dim LOHeaderRow, Row As Integer
LOName = Activecell.ListObject.Name
Row = Activecell.Row
LOHeaderRow = ActiveSheet.ListObjects(LOName).HeaderRowRange.Row
LORow = Row - LOHeaderRow
Debug.Print (LORow)
FuncTableRow = LORow
End Function
You also don't Call a function, you can just insert it as itself in a subroutine.
You are using LORow as an input variable but then changing it. That's typically a bad practice.
You should not be using ActiveSheet grab the worksheet from TbleCell.Worksheet
You would almost never use activecell as part of a Custom Formula.
Dim LOHeaderRow, Row As Integer should actually be Dim LOHeaderRow as Long, Row As Long. As you currently have it LOHeaderRow is undefined/Variant.
There's probably more. I would restart your process with a simpler task of returning the last used cell in a worksheet. There's a dozen ways to do this and lots of help examples.
Take a look at this TheSpreadsheetGuru.
Here are some variables that might help you.
Sub TableVariables()
Dim ol As ListObject: Set ol = ActiveSheet.ListObjects(1)
Dim olRng As Range: Set olRng = ol.Range ' table absolute address
Dim olRngStr As String: olRngStr = ol.Range.Address(False, False) ' table address without absolute reference '$'
Dim olRow As Integer: olRow = ol.Range.Row ' first row position
Dim olCol As Integer: olCol = ol.Range.Column ' first column position
Dim olRows As Long: olRows = ol.Range.Rows.Count ' table rows including header
Dim olCols As Long: olCols = ol.ListColumns.Count ' table columns
Dim olListRows As Long: olListRows = ol.ListRows.Count ' table rows without header
End Sub
I have a data table with column headings. I have a list of column headings that I don't want.
I want to delete the unwanted column headings no matter where they are in the worksheet and the ability for users to add other columns to delete.
I get
run time 91 error
on this line: ws.Rows("1:1").Select.Find(T).EntireColumn.Delete
Sometimes I will get an error in the first loop of the code, sometimes it will be part way through.
I have looked at other posts but the problems have not be related enough for me to problem solve my way through. I tried reading some articles on defining objects. I have been using the msgbox command to make sure the code is finding the values and that seems to be working all the time but it breaks down at the Find command.
Sub DeleteBadHeaders2()
Dim FirstHeading As Range
Set FirstHeading = Worksheets("Headings_To_Delete").Range("a2")
'Worksheet that has all the column headings I want deleted
Dim x As Integer
'x is for the do while loop to individually highlight each cell
Dim y As Long
y = Worksheets("Headings_To_Delete").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
'y acts as the upper bound to the headings to delete column for the while loop
Dim T As Variant
'T acts as a temporary value holder that will be used to delete the proper columns
Dim ws As Worksheet
Set ws = ActiveSheet
x = 0
Do While x < (y - 1)
Worksheets("Headings_To_Delete").Range("a2").Offset(x, 0).Interior.Color = RGB(224, 0, 0)
'Calling the rage as above fixes the active cell problem
Let T = Worksheets("Headings_To_Delete").Range("a2").Offset(x, 0).Value
'MsgBox T & " is found."
ws.Rows("1:1").Select.Find(T).EntireColumn.Select
'for testing switch the last part of the code to EntireColumn.Interior.Color = RGB(0, 225, 0)
x = x + 1
Loop
'The loop is highlighting the cells incrementally based on the first active cell until the upper limit of how many cells are in the column
End Sub
ws.Rows("1:1").Select.Find(T).EntireColumn.Select
should be
ws.Rows(1).Find(T).EntireColumn.Select 'Delete?
Typically though whenever using Find() it's a good idea to check you actually found anything, by testing the return value for Nothing before trying to do anything like Select or Delete.
Also a good idea to be explicit about some of the other parameters in Find, such as lookAt for example.
Something like this:
Sub DeleteBadHeaders()
Dim r As Long, lastRow As Long
Dim T As Variant
Dim ws As Worksheet, wsList As Worksheet, f As Range
Set ws = ActiveSheet
Set wsList = Worksheets("Headings_To_Delete")
lastRow = wsList.Cells(Rows.Count, 1).End(xlUp).Row 'last row
For r = 2 To lastRow
T = wsList.Cells(r, "A").Value
If Len(T) > 0 Then
Set f = ws.Rows(1).Find(what:=T, lookat:=xlWhole)
'check to see if the heading was found
If Not f Is Nothing Then
Debug.Print "Found header '" & T & "' at " & f.Address
f.EntireColumn.Interior.Color = vbRed '<< for testing
'f.EntireColumn.Delete '<< uncomment when done testing
End If 'was found
End If 'any heading
Next r 'next in list
End Sub
This is my first post, so please provide any feedback about my approach to presenting the problem.
I'm building a sub that (ultimately) is supposed to copy a range from one sheet ("Sandbox") to another ("Master"). The steps are:
Identify the selected rows
Loop through the Sandbox rows, determining whether to find a matching Master row or add as a new end-row in Master
Copy the values only from each selected Sandbox row to the appropriate Master row
The error pops with the setting the range for the PasteSpecial function. That line consistently gives a "1004 (Method 'Range' of object '_Global' failed" message.
Here's the code :
Sub UpdateMaster()
Dim currentSelection As Range
Set currentSelection = Selection
Dim sheetSB As Worksheet
Set sheetSB = ThisWorkbook.Sheets("Sandbox")
Dim sheetMaster As Worksheet
Set sheetMaster = ThisWorkbook.Sheets("Master")
Dim lastTargetRow As Integer
lastTargetRow = sheetMaster.Range("IDRange").End(xlDown).Row + 1
Dim startingTargetColumn As Integer
startingTargetColumn = sheetMaster.Range("IDRange").Column
Dim thisID As String
Dim thisStatus As String
For Each thisrow In currentSelection.Rows
' Capture the current ID value
thisID = Cells(thisrow.Row, Range("IDRange").Column).Value
' Capture the current Status value
thisStatus = Cells(thisrow.Row, Range("NewRange").Column).Value
' If the row has no ID...
If thisID = "" Then
' ...do nothing
' If the row is flagged as new...
ElseIf thisStatus = "New" Then
'...identify the first blank row, and set all data columns to be copied
Range(Cells(thisrow.Row, Range("IDRange").Column), Cells(thisrow.Row, Range("LastSandboxColumn")).Column).Copy _
Destination:=sheetMaster.Range(lastTargetRow, startingTargetColumn)
' Increment the next available last row by 1
lastTargetRow = lastTargetRow + 1
Else
' Otherwise, find the corresponding row and set the non-ID columns to be copied
Dim sourceColumn1 As Integer, sourceColumn2 As Integer
Dim targetRow As Integer, targetColumn As Integer
Dim matchRow As Integer
sourceColumn1 = Range("IDRange").Column + 1
sourceColumn2 = Range("LastSandboxColumn").Column
targetRow = Application.WorksheetFunction.Match(thisID, sheetMaster.Range("IDRange"), 0)
targetColumn = startingTargetColumn + 1
Range(Cells(thisrow.Row, sourceColumn1), Cells(thisrow.Row, sourceColumn2)).Copy
Range(sheetMaster.Cells(targetRow, targetColumn)).PasteSpecial xlPasteValues
End If
Next
End Sub
The error is happening on the last line:
Range(sheetMaster.Cells(targetRow, targetColumn)).PasteSpecial xlPasteValues
Inexplicably, the following seems to work:
Range(Cells(thisrow.Row, sourceColumn1), Cells(thisrow.Row, sourceColumn2)).Copy _
Destination:=Range(sheetMaster.Cells(targetRow, targetColumn))
Unfortunately, I want only the values; bringing over formulas and formatting will screw up other behavior in the sheet.
I have tried many variations, but essentially it will not allow me to create a range, referencing Master, if I use Cells().
Any help much appreciated.
Just do:
sheetMaster.Cells(targetRow, targetColumn).PasteSpecial xlPasteValues
An error could occur with this, if the sheetMaster isn't the ActiveSheet at runtime:
Range(sheetMaster.Cells(targetRow, targetColumn).PasteSpecial) xlPasteValues
Also note, for this problem:
Unfortunately, I want only the values; bringing over formulas and formatting will screw up other behavior in the sheet.
You can get the range's .Value as an array, and write it directly to the other sheet without invoking either Copy or Paste/PasteSpecial methods. The answer below shows several methods of copying/pasting from one workbook to another, but could easily be modified for sheet-to-sheet transfer, instead.
Copy from one workbook and paste into another
The code I've written below to replace some index match formulas in a sheet. It seems to work well enough, but I think the loop is a bit clumsy and may be prone to errors. Does anyone have any recommended improvements?
Sub match_SIC_code_sheet_loop()
'sic code needs to match value in column j or a in sic code sheet, '
'if not available = met10 works, but probably needs a bit more
'debugging to make it robust.
Dim ws As Integer
Dim lastrow As Long
Dim lastrow_sic As Long
Dim output_wb As Workbook
Dim SIC_sheet As Worksheet
Dim Demand_CAT As String
Dim sic_DMA As String
Dim i As Integer
Dim row As Integer
Dim WS_count As Long
Dim x As String
Dim y As String
Set output_wb = Workbooks("DMA_customers_SICTEST.xlsx") 'use thisworkbook instead
Set SIC_sheet = Workbooks("DMA_metered_tool_v12_SICTEST.xlsm").Sheets("SIC codes")
With SIC_sheet 'count the number of SIC codes to search through
lastrow_sic = .Range("j" & .Rows.Count).End(xlUp).row
End With
With output_wb 'count the no. of sheets in the generated customer workbook
WS_count = output_wb.Worksheets.Count
End With
With output_wb
For ws = 1 To WS_count 'loop through each sheet in the customer workbook
With output_wb.Sheets(ws)
y = output_wb.Sheets(ws).Name
lastrow = .Range("a" & .Rows.Count).End(xlUp).row ' number of rows in the
'current customer sheet
For i = 2 To lastrow 'data starts in row 2; sic code in column 9
sic_DMA = .Cells(i, 9).Text 'the lookup value
With SIC_sheet
'SIC codes start in row 2, if the sic code matches,
'the correct demand category is appointed, if the sic code does not
'match, then MET_10 is given as the default value.
For row = 2 To lastrow_sic
x = .Cells(row, 3).Text
If x = sic_DMA Then
Demand_CAT = .Cells(row, 10).Text
Exit For
Else
Demand_CAT = "MET_10"
End If
Next row
output_wb.Sheets(ws).Cells(i, 23).Value = Demand_CAT
End With
Next i
End With
Next ws
End With
output_wb.Save
End Sub
Thanks
For starters you could break that long procedure into a few smaller methods. For example you could have a ProcessSheet procedure into which you pass each sheet under :
For ws = 1 To WS_count 'loop through each sheet in the customer workbook
That would definitely help readability etc. If you're still not satisfied then continue breaking the loop into smaller logical procedures. Just don't go too crazy.
Apart from that some error checking and value validation would go a long way in a deeply nested loop. For example ensure that various calculated variables such as 'lastrow' are correct or within a valid threshold etc.
Finally instead of hardcoded values sprinkled through your long loop like magically camoflauged debug-from-hell-where's-waldo fairies; prefer instead a few meaningfully named Const variable alternatives i.e.
Private Const SIC_START_ROW = 2
I am trying to search for a "/" in a cell within the first column. I need to go through 13 worksheets, find the cell that contains that "/" (which may also contain other text), and highlight that row. Ive been testing out code I've found online and haven't had much luck in getting through the whole workbook.
Dim value As String
value = "/"
x = 1
For x = 1 To 13 Step -1
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For y = 1 To lastrow
Range("a" & i).Find (value)
Range("a" & i).Rows.Interior.Color = RGB(256, 1, 1)
Next y
Next x
This is the code I'm using. If anyone could offer some assistance I'd greatly appreciate it.
It's irrelevant to your question, but the first thing I noticed was:
For x = 1 To 13 Step -1
This will never work; a negative step will only work if the order of the values is descending.
You're missing any selection of a worksheet. If you are iterating through all worksheets in the workbook, then easiest way to do it is with For each wks in Worksheets.
Find in Excel VBA is a little convoluted. A call to Find returns the first cell in the range that contains the specified text. You then need to make subsequent calls to FindNext to get any other matching cells. But, FindNext will run forever -- you need to save a reference to the first matched cell, then compare the result you get from FindNext until the first matched cell shows up again.
Here's how I would do it:
Sub foo()
Dim value As String: value = "/"
Dim rSearch As Range
Dim firstFound As Range
Dim nextFound As Range
Dim wks As Worksheet
For Each wks In Worksheets
wks.Activate
Set rSearch = Range("a1", Cells(Rows.Count, "a").End(xlUp))
Set firstFound = rSearch.Find(value)
If Not firstFound Is Nothing Then
Set nextFound = firstFound
Do
nextFound.EntireRow.Interior.Color = RGB(256, 1, 1)
Set nextFound = rSearch.FindNext(nextFound)
Loop While nextFound.Address <> firstFound.Address
End If
Next
End Sub