the code below works 100%. It scans for a match in Column B and copies and renames a group of cells when a match is found. However the is a line For lRow = Sheets("HR-Calc").Cells(Cells.Rows.count, "b").End(xlUp).Row To 7 Step -1
Where the step -1
will scan row by row from the bottom of the sheet until a match is found. It would be much easier if the step was set to End.(xlUp)
instead of -1
. searching every row is overkill because of how the data is set up End.(xlUp)
would massive cut down the run time.
Is something like this possible?
Sub Fill_CB_Calc()
M_Start:
Application.ScreenUpdating = True
Sheets("summary").Activate
d_input = Application.InputBox("select first cell in data column", "Column Data Check", Default:="", Type:=8).Address(ReferenceStyle:=xlA1, RowAbsolute:=True, ColumnAbsolute:=False)
data_col = Left(d_input, InStr(2, d_input, "$") - 1)
data_row = Right(d_input, Len(d_input) - InStr(2, d_input, "$"))
Application.ScreenUpdating = False
Sheets("summary").Activate
Range(d_input).End(xlDown).Select
data_last = ActiveCell.Row
If IsEmpty(Range(data_col & data_row + 1)) = True Then
data_last = data_row
Else
End If
For j = data_row To data_last
CBtype = Sheets("summary").Range(data_col & j)
Sheets("HR-Calc").Activate
For lRow = Sheets("HR-Calc").Cells(Cells.Rows.count, "b").End(xlUp).Row To 7 Step -1
If Sheets("HR-Calc").Cells(lRow, "b") = CBtype Then
CBend = Sheets("HR-Calc").Range("C" & lRow).End(xlDown).Row + 1
Sheets("HR-Calc").Rows(lRow & ":" & CBend).Copy
CBstart = Sheets("HR-Calc").Range("c50000").End(xlUp).Row + 2
ActiveWindow.ScrollRow = CBstart - 8
Sheets("HR-Calc").Range("A" & CBstart).Insert Shift:=xlDown
CBold = Right(Range("c" & CBstart), Len(Range("C" & CBstart)) - 2)
box_name = Sheets("summary").Range(data_col & j).Offset(0, -10)
CBnew = Right(box_name, Len(box_name) - 2) & "-" ' <--this is custom and can be changed based on CB naming structure
If CBnew = "" Or vbCancel Then
End If
CBend2 = Range("c50000").End(xlUp).Row - 2
Range("C" & CBstart + 1 & ":" & "C" & CBend2).Select
Selection.Replace What:=CBold & "-", Replacement:=CBnew, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("C" & CBstart).FormulaR1C1 = "CB" & Left(CBnew, Len(CBnew) - 1)
GoTo M_Start2
Else
End If
Next lRow
M_Start2:
Next j
YN_result = MsgBox("Fill info for another block/inverter?", vbYesNo + vbExclamation)
If YN_result = vbYes Then GoTo M_Start
If YN_result = vbNo Then GoTo jumpout
jumpout:
' Sheets("summary").Range(d_input).Select
Application.ScreenUpdating = True
End Sub