VBA to copy cell location to found cell in another worksheet - excel

I have a sub routine which I want to take the worksheet name and search through every column B in all worksheets, once it has found a match I want it to take a direct link to the 'total' cell from the first workbook. this 'total' cell will always be the last cell in column 'J' however the row will change.
The worksheet name is determined by an earlier sub which imports a CSV
The cell where the 'total' reference should be placed is offset from the search result, it needs to be a link so if the value changes, the cell will update to match the new total.
So far I am able to 'find' the cell using worksheet name, however the value entered into the offset cell is the heading from the first worksheet, not a linked value to the 'total'
Sub Item_Return()
Dim scanstring As String
Dim foundscan As Range
scanstring = ActiveSheet.Name
Dim lcaddr As Range
Set lcaddr = Range("J" & Range("J1", Range("J" & Rows.Count).End(xlUp)).SpecialCells(xlConstants, xlTextValues).Rows.Count)
For Each Sh In ThisWorkbook.Sheets
With Sh.Columns("B")
Set foundscan = .Find(What:=scanstring, LookIn:=xlValues, Lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End With
If Not foundscan Is Nothing Then
foundscan.Offset(0, 1).Value = lcaddr.Address(External:=True)
Sh.Activate
foundscan.Activate
ActiveWindow.ScrollRow = foundscan.Row
Exit Sub
End If
Next
MsgBox scanstring & " was not found"
End Sub
The value returned is not the linked cell to last used cell in row "J", it is the value in the first cell in row "J"
Any and all help is appreciated

I just needed to change the range to select the cell only so Set lcaddr = Range("J" & Range("J1", Range("J" & Rows.Count).End(xlUp)).SpecialCells(xlConstants, xlTextValues).Rows.Count) became
Set lcaddr = Range("J1").End(xlDown)

Related

EXCEL VBA: How to filter on same column header across multiple worksheets

I'm trying to filter on a column labeled "Date" across 10 worksheets. The column "Date" may not be in the same column position for every worksheet.
Is there a macro or code I can use to filter on the "Date" column in one easy button push? Instead of going to each individual worksheet and filtering separately..
I would only be filtering on the same date for all worksheets. For example, if I wanted to filter on "9/3/2021", I would go to each worksheet and find the "Date" column and manually filter 10 times.
if you add two simple cells to one of your sheets containing the header text and the value you want to filter you can use the below code to achieve the intended result.
for example my header named "Date" so in my first sheet I wrote "Date" in A3 and the date I want to filter into A4. just keep in mind that since we are searching for the "Date" header in first row either we should put our so called Criteria Range header in another row or since our search ends with first occurrence we can add the new header to one of the columns after our original Date column.
Note:
The Criteria Range table headers must be exactly like the target selection headers for this to work. so here I have one column and one header, and I only selected the Date column.
Sub Test()
Dim Rng As Range
For i = 1 To 4
With Sheets(i).Range("A1:Z1")
Set Rng = .Find(What:="Date", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
'################################# New Part ▼
' R will be the address of the found column in Range format (e.g. "F1")
R = Rng.Address(RowAbsolute:=False, ColumnAbsolute:=False)
Dim rgData As Range, rgCriteria As Range
' rgCriteria is the two cells Criteria Range
Set rgCriteria = Sheets(1).Range("A3:A4")
' these next two lines are adding the Date column range to rgData
LastRow = Sheets(i).Cells(Rows.Count, Rng.Column).End(xlUp).Row
Set rgData = Sheets(i).Range(Sheets(i).Range(R), Sheets(i).Cells(LastRow, Rng.Column))
' since I was disappointed in AutoFilter I used Advanced Filter and its even faster
rgData.AdvancedFilter xlFilterInPlace, rgCriteria
'################################# New Part ▲
Else
MsgBox "Nothing found"
End If
End With
Next i
End Sub
That's All!
References:
○ - Thanks to this Excel Macro Mastery channel video. make sure to watch it to get a better understanding of what I wrote.
you can find the "Date" column (which I presume there is a row contains the word "Date") by searching that row (e.g. first row of each sheet) for the word "Date". then you can give the column number to your filtration sub and get your filtering result.
1st Way
Sub Test()
For i = 1 To 10
For j = 1 To 50
If Worksheets(i).Cells(1, j).Value = "Date" Then
' here goes your filtration procedure on j column
Exit For
End If
Next j
Next i
End Sub
which i is the number of worksheets and j is the found column (in first 50 columns)
2nd Way (Faster Way)
Using Range.Find which suggested by #BigBen because:
Looping cell-by-cell is slow and inefficient
Sub Test()
Dim Rng As Range
For i = 1 To 5
With Sheets(i).Range("A1:Z1")
Set Rng = .Find(What:="Date", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
' here goes your filtration procedure on (Rng.Column)
Else
MsgBox "Nothing found"
End If
End With
Next i
End Sub
which i is the number of worksheets and Rng.Column is the found column (in A1:Z1 range)
References:
Microsoft Docs page for Range.Find method
there is another Microsoft Docs Page if you want
to use Application.Match method

Find number in column, insert row below column, populate with data, and then repeat until it has found all of the pre-defined numbers

I need to find the value "5005" (only this value) in column J:J, insert a new row below it, and then fill the row with values in columns A-U.
I am new to VBA and I am unable to do this without making a mess of code.
The draft would look something like this
Find all cells with value 5005 in column J:J,
Insert Row below,
Put value1 in A,
Put Value2 in B,
etc.... until column U,
Repeat on the next cell that has "5005" in it until there are no more
I am unsure what code would work best at this point and I think seeing this written out by a pro would help significantly.
In the messy code I've provided below I was able to search for the value "5005" and insert a line below it, but whatever cell I have selected in excel will be filled with the value "TRUE" and the code is quite messy. Not sure If I was going the right direction with it.
Sub AAAAAAAtest()
Dim find5005 As Range
'Have excel search 1 column instead of all cell
Set find5005 = Cells.Find(What:="5005", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
If find5005 Then ActiveCell.Value = find5005.Offset(1).EntireRow.Insert
End Sub
Narrative is in the code comments
Option Explicit
Sub insert5005()
Dim rng As Range, urng As Range, faddr As String
Dim vals As Variant
'get some dummy values quickly
vals = buildAU()
With Worksheets("sheet5")
'find first 5005
Set rng = .Range("J:J").Find(What:="5005", after:=.Cells(.Rows.Count, "J"), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
'continue if found
If Not rng Is Nothing Then
'record first found cell
faddr = rng.Address
'start loop for insert, populate and additional cells
Do
'insert new row
rng.Offset(1, 0).EntireRow.Insert
'populate row
.Cells(rng.Offset(1, 0).Row, "A").Resize(1, UBound(vals) + 1) = vals
'look for another
Set rng = .Range("J:J").FindNext(after:=rng)
'keep going until first address is reached a second time
Loop Until rng.Address = faddr
End If
End With
End Sub
Function buildAU()
'construct some dummy values
Dim i As Long, tmp As String
For i = 65 To 85
tmp = tmp & Format(i, "|v\alu\e00")
Next i
buildAU = Split(Mid(tmp, 2), Chr(124))
End Function

How to select entire column if there is a text match in columns and move to a specific sheet?

I have an excel spreadsheet which generate different column names every time, but has the same starting word.
So for example, I could have a column with the name "Key" , after 2 to three columns there would columns with names as key3,key29 likewise I have another word called value and then value1,value2 after some columns value6,value7 etc
What I want to do is to search the columns names in the sheet Rows("1:1").Select and select the entire column if a text matches to the value I assign and finally copy it to separate sheet.
So far this is what I tried.
Rows("1:1").Select 'Selecting the columns row
' Finding values with name i want to look for
Selection.Find(What:="key", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate.Select
Option Explicit
Sub test()
Dim cell As Range, rng As Range
Dim SearchString As String
Dim LastColumn As Long
SearchString = "Test"
With ThisWorkbook.Worksheets("Sheet1")
Set rng = .Rows("1")
For Each cell In rng.Cells
If InStr(1, cell.Value, SearchString) > 0 Then
LastColumn = ThisWorkbook.Worksheets("Sheet2").Cells(1, ThisWorkbook.Worksheets("Sheet2").Columns.Count).End(xlToLeft).Column
.Columns(cell.Column).Copy ThisWorkbook.Worksheets("Sheet2").Columns(LastColumn + 1)
End If
Next
End With
End Sub
The code below will give a great start. Adjust any worksheet, cell and range references as needed. There's also a ton of resources on what each method I used does in case anything is unfamiliar to you.
With Worksheets("Sheet1")' change as needed
Dim lastRow as Long
lastRow = .Cells(.Rows.Count,1).End(xlUp).Row 'change column as needed
Dim headers as Range
Set headers = .Range("A1",.Cells(1,.Columns.Count).End(xlToLeft))
Dim findIt as String
findIt = "key"
Dim cel as Range
For each cel in headers
If cel.Text like "*key*" Then
.Range(cel,.Cells(lastRow, cel.Column)).Copy worksheets("sheet2").Cells(1,cel.Column) 'change sheet and column as needed
End if
Next
End With

Find Code from Another Sheet and Return Info From Same Row

I have searched to find the answers to get to where I am but am now stuck! I am a relative beginner with VBA.
I have a Workbook that lists a few hundred orders that we are producing for our customer.
The order details are on the first sheet called "In Progress" and on the 3rd sheet called "StyleData" are more details about each product such as its composition, design reference, SKU etc...
At present my code searches column A on the Data sheet based on the 6 digit style code in the active cell on the In Progress Sheet, then goes to that cell. I have put a MsgBox in purely to put a pause in the code so I know where it has got to.
What I want it to do after finding the style code on the data sheet is return a value on the same row from column H, preferable in a format that the use can select and copy, then it will return to the original cell at the start of the macro.
Code as follows:
Sub get_composition()
Dim item_no As String
Dim data_sheet As Worksheet
Dim found_item As Range
Set Rng = ActiveCell
item_no = ActiveCell.Value
Set data_sheet = Sheets("StyleData")
If Trim(item_no) <> "" Then
With Sheets("StyleData").Range("A:A")
Set found_item = .Find(What:=item_no, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not found_item Is Nothing Then
Application.Goto found_item, True
Else
MsgBox "Nothing found"
End If
End With
End If
MsgBox "Return to Original Cell"
Application.Goto Rng
End Sub
if I understand what you want :
you arrive at cell "found_item" and want to return a value from the same row.
If it's so, you can use method Offset on "found_item"
found_item.Offset() allow you to navigate from the current range
https://msdn.microsoft.com/en-us/library/office/ff840060.aspx
If you are on column A, found_item.Offset(, 1) will return the range on the same line but column B

Macro code to read value of a cell in Excel & enter a given value in a second sheet on corresponding row

Looking for some help with a fairly basic excel macro to read a value in a cell on one Excel sheet and then find that value in a second sheet and enter a pre-defined value into a specified cell in that row.
To break it down...
Read the value of a given cell in sheet_1 (this will be an ID number)
Go to sheet_2, find the ID number in column_a
Go to a given column in that row
Write a pre-defined value into the cell
Thanks!
This may point you in the right direction:
Sub FindID()
Dim ID_Number As String
Dim col As Integer
Dim rw As Integer
Dim WS As Worksheet
Set WS = Activeworkbook.Sheets("sheet_2")
ID_Number = Activecell.Value 'reads value of ID_Number in WS 1; assumes you have selected the ID_Number you want to work with
With WS
.Activate
.Range("A1").Activate
End With
WS.Range("A:A").Cells.Find(What:=ID_Number, After:=ActiveCell, LookIn:=xlFormulas, _ 'finds ID_Number in WS 2
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
rw = Activecell.Row
col = 'whatever column you want to look at, expressed as an integer; A=1, B=2,...
WS.Cells(rw, col).Value = ID_Number 'write ID_Number to cell
End Sub
You can use the "Find" method of the "Cells" object to search for the column you want to look at, as well, if you want to make your code more dynamic.

Resources