Spending some time with my code I realized I need your help.
The problem is following. I have a file with VBA code in it (ThisWorkbook) and i'm trying to open another excel book to copy data from three different sheets there and paste into my excel in thee different sheets either. Copying the data from first two sheets goes flawlessly but there is problem with the third one.
The interest thing is that when I try do my job in debug mode, everything goes right, but when i run macro the problem exists.
Here is my code:
Option Explicit
Const NORMAT_START_POINT = 3 'data starts from this row after header
Const PA_MAN_ADJ_START_POINT = 9
Sub copy_paste_data_to_checklist()
Dim FileToOpen As Variant
Dim WorkingFile As Workbook
Dim countCompanies As Long
Dim period As Variant 'month and year for copy paste the table header
Dim no_sent_reports_count As Long
countCompanies = licenses.Range("A1").End(xlDown).Row
period = fzp_nzp_pa.Range("Q1").Value
'On Error GoTo handle
no_sent_reports_count = VBA.InputBox("How many companies didn't provide reports for
previous quarter?", "Enter data")
'On Error GoTo 0
Call EntryPoint
FileToOpen = Application.GetOpenFilename(FileFilter:="Excel files(*.xlsb), *.xlsb", Title:="Select a file to import data from")
'clear data before pasting new values
fzp_nzp_pa.Range("A3", "M" & countCompanies + NORMAT_START_POINT).ClearContents
nro_nja_normat.Range("A3", "L" & countCompanies + NORMAT_START_POINT).ClearContents
'open file with nornativ
'''''''''''''''''''''''''''''''''''''''''''''copy paste fzp_nzp_pa'''''''''''''''''''''''''''''''''''''''
If FileToOpen <> False Then
Set WorkingFile = Workbooks.Open(FileToOpen)
WorkingFile.Application.Calculation = xlCalculationManual
If isWorkbookOpen(WorkingFile.Name) = True Then
'Application.Wait (Now + TimeValue("0:00:30"))
WorkingFile.Worksheets("Íîðìàòèâû").Range("A3", "B" & countCompanies + NORMAT_START_POINT).Copy
fzp_nzp_pa.Range("A3").PasteSpecial xlPasteValues
'fzp_nzp
WorkingFile.Worksheets("Íîðìàòèâû").Range("F3", "G" & countCompanies + NORMAT_START_POINT).Copy
fzp_nzp_pa.Range("C3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("Íîðìàòèâû").Range("K3", "K" & countCompanies + NORMAT_START_POINT).Copy
fzp_nzp_pa.Range("E3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("Íîðìàòèâû").Range("Q3", "Q" & countCompanies + NORMAT_START_POINT).Copy
fzp_nzp_pa.Range("F3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("Íîðìàòèâû").Range("V3", "V" & countCompanies + NORMAT_START_POINT).Copy
fzp_nzp_pa.Range("G3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("Íîðìàòèâû").Range("M3", "N" & countCompanies + NORMAT_START_POINT).Copy
fzp_nzp_pa.Range("H3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("Z9", "Z" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
fzp_nzp_pa.Range("J3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AO9", "AO" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
fzp_nzp_pa.Range("K3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AV9", "AV" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
fzp_nzp_pa.Range("L3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("Íîðìàòèâû").Range("S3", "S" & countCompanies + NORMAT_START_POINT).Copy
fzp_nzp_pa.Range("M3").PasteSpecial xlPasteValues
'''''''''''''''''''''''''''''''''''''''''copy paste nro_nja_normat'''''''''''''''''''''''''''''''''''''''
WorkingFile.Worksheets("Íîðìàòèâû").Range("A3", "B" & countCompanies + NORMAT_START_POINT).Copy
nro_nja_normat.Range("A3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AA9", "AA" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_normat.Range("C3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AB9", "AB" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_normat.Range("D3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AC9", "AC" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_normat.Range("E3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AF9", "AF" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_normat.Range("F3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AF9", "AF" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_normat.Range("F3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AG9", "AG" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_normat.Range("G3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AL9", "AL" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_normat.Range("H3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AP9", "AP" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_normat.Range("I3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AS9", "AS" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_normat.Range("J3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AT9", "AT" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_normat.Range("K3").PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AU9", "AU" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_normat.Range("L3").PasteSpecial xlPasteValues
''''''''''''''''''''''''''''''''''''''''copy paste to nro_nja_archive''''''''''''''''''''''''''''''''''''
'copy the header
nro_nja_archive.Range("A2:S2").Copy
'paste it 5 rows below the last found non-empty cell
nro_nja_archive.Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 5 + no_sent_reports_count).PasteSpecial xlPasteAllUsingSourceTheme
'insert period date above the header in column A
fzp_nzp_pa.Range("Q1").Copy
nro_nja_archive.Range("A" & Range("A" & Rows.Count).End(xlUp).Row - 1).PasteSpecial xlPasteValues
'nro_nja_archive.Range("A" & Range("A" & Rows.Count).End(xlUp).Row - 1).Value = period
nro_nja_archive.Range("A" & Range("A" & Rows.Count).End(xlUp).Row - 1).Interior.Color = VBA.RGB(158, 28, 176)
nro_nja_archive.Range("A" & Range("A" & Rows.Count).End(xlUp).Row - 1).Font.Color = vbWhite
'copy paste data to nro_nja_archive
WorkingFile.Worksheets("Íîðìàòèâû").Range("A3", "B" & countCompanies + NORMAT_START_POINT).Copy
nro_nja_archive.Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AO9", "AO" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("C" & Range("C" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("Íîðìàòèâû").Range("Q3", "Q" & countCompanies + NORMAT_START_POINT).Copy
nro_nja_archive.Range("D" & Range("D" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AB9", "AB" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("E" & Range("E" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AF9", "AF" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("F" & Range("F" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AA9", "AA" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("G" & Range("G" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AL9", "AL" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("H" & Range("H" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AG9", "AG" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("I" & Range("I" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AC9", "AC" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("J" & Range("J" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AV9", "AV" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("K" & Range("K" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("Íîðìàòèâû").Range("V3", "V" & countCompanies + NORMAT_START_POINT).Copy
nro_nja_archive.Range("L" & Range("L" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AP9", "AP" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("M" & Range("M" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AS9", "AS" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("N" & Range("N" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AU9", "AU" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("O" & Range("O" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("ÏÀ_manual_adj").Range("AT9", "AT" & countCompanies + PA_MAN_ADJ_START_POINT).Copy
nro_nja_archive.Range("P" & Range("P" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Worksheets("Íîðìàòèâû").Range("W3", "Y" & countCompanies + NORMAT_START_POINT).Copy
nro_nja_archive.Range("Q" & Range("Q" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
WorkingFile.Close False
MsgBox "Done!", vbInformation, "Task completed"
End If
End If
Call ExitPoint
' Exit Sub
'handle:
End Sub
Sub EntryPoint()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
.StatusBar = "Winter is coming"
End With
End Sub
Sub ExitPoint()
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.CutCopyMode = False
.StatusBar = ""
End With
End Sub
Function isWorkbookOpen(WorkbookName As String) As Boolean
Dim wb As Workbook
On Error Resume Next
Set wb = Application.Workbooks(WorkbookName)
On Error GoTo 0
If wb Is Nothing Then
isWorkbookOpen = False
Else
isWorkbookOpen = True
End If
End Function
The problem starts from this block :
''''''''''''''''''''''''''''''''''''''''copy paste to nro_nja_archive''''''''''''''''''''''''''''''''''''
It should take data from opened file and insert it below the last rows with data. It seems like file isn't loaded fully when the code executes, since data are being pasted anywhere but not below the last row. Again, when in debug mode everything is working just fine... I need somehow make the vba code wait until another excel file is fully loaded before performing copy paste.
Any help will be much appreciated!
Related
I want to make a button that copies a certain formulas within a range, and inserts it below the activecell.
It works, but now the formula reference keeps linking to the formula above it, I need it to act like an AutoFill,
Sub Rijen_Toevoegen()
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown
Range("B" & ActiveCell.Row + 1 & ":H" & ActiveCell.Row + 1).Formula = Range("B" & ActiveCell.Row & ":H" & ActiveCell.Row).Formula
End Sub
You can use autofill like this:
Sub Rijen_Toevoegen()
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown
Range("B" & ActiveCell.Row & ":H" & ActiveCell.Row).AutoFill Destination:=Range("B" & ActiveCell.Row & ":H" & ActiveCell.Row + 1)
End Sub
Look that the destination range must include the ActiveCell's row "B" & ActiveCell.Row and also the row you are filling ":H" & ActiveCell.Row + 1 (plus 1)
Let me know if it works
Offset should be used like this:
currentSheet.yourRange.Offset(offsetRow, offsetColumn)
With that, you should change your code to:
Sub Rijen_Toevoegen()
ActiveCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Range("B" & ActiveCell.Row + 1 & ":H" & ActiveCell.Row + 1).Formula = Range("B" & ActiveCell.Row & ":H" & ActiveCell.Row).Formula
End Sub
Also, it is recommended to avoid using .Select, .Active, ActiveCell and the likes.
I am new to this VBA and need some help with my code. I manage to get my code to vlookup from last row in column O but I dont know how to fill it to match last row of column E.
My goal is vlookup from last row of O fill to last row of E
Dim JPNpart, PartNumber, myRange, LastRow As Long
LastRow = Range("E" & Rows.Count).End(xlUp).Row
JPNpart = "[JPN_part.xlsx]Sheet1"
Sheets("Sheet1").Select
Range("O2").Select
Selection.End(xlDown).Offset(1, 0).Select
PartNumber = ActiveCell.Offset(0, -13).Address
myRange = "'" & JPNpart & "'!A:G"
Range("O2").Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveCell.Formula = "=VLOOKUP(" & PartNumber & "," & myRange & ", 7, FALSE)"
'how i do to make this formula fill till last row
Range("P2").Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveCell.Formula = "=VLOOKUP(" & PartNumber & "," & myRange & ", 2, FALSE)"
Range("E2").Select
Selection.End(xlDown).Select
Thanks for your help.
You could have figured it out by cleaning the Select/Selection and Activate/ActiveCell.
Here is your code cleaned of that and made more understable :
Dim JPNpart As String, PartNumber As String, myRange As String, LastRow As Long
JPNpart = "[JPN_part.xlsx]Sheet1"
myRange = "'" & JPNpart & "'!A:G"
With ThisWorkbook.Sheets("Sheet1")
'For column O
LastRow = .Range("O" & .Rows.Count).End(xlUp).Row
PartNumber = "B" & LastRow + 1
.Range("O" & LastRow).Offset(1, 0).Formula = "=VLOOKUP(" & PartNumber & "," & myRange & ", 7, FALSE)"
'For column E
LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
PartNumber = "B" & LastRow + 1
.Range("E" & LastRow).Offset(1, 0).Formula = "=VLOOKUP(" & PartNumber & "," & myRange & ", 7, FALSE)"
End With 'ThisWorkbook.Sheets("Sheet1")
I am attempting to write a macro that checks each row in one sheet called raw data for a matching name and if the name matches, copy the data from that row over to a sheet called name search. I am attempting to do this using a do while loop similar to one that i have used successfully in the past.
However when I try to run it, it gives me the error "Loop without do" despite the fact that everything seems to be in the correct place. my code is as follows:
Sub NameSearch()
Sheets("Raw Data").Unprotect ("29745")
Application.ScreenUpdating = False
Dim x As Long
'set starting point at row 2
x = 2
Dim sourceSheet As Worksheet: Set sourceSheet = ThisWorkbook.Worksheets("Raw Data")
Dim destSheet As Worksheet: Set destSheet = ThisWorkbook.Worksheets("Name Search")
Do While sourceSheet.range("A" & x).Value <> ""
If sourceSheet.range("O" & x).Value <> destSheet.range("B2") Then
x = x + 1
Else
If sourceSheet.range("O" & x).Value = destSheet.range("B2") Then
'selects the next row where the 1st column is empty
lMaxRows = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row
'pastes the data from the specified cells into the next empty row
destSheet.range("A" & lMaxRows + 1).Value = sourceSheet.range("A" & x).Value
destSheet.range("B" & lMaxRows + 1).Value = sourceSheet.range("B" & x).Value
destSheet.range("C" & lMaxRows + 1).Value = sourceSheet.range("C" & x).Value
destSheet.range("D" & lMaxRows + 1).Value = sourceSheet.range("D" & x).Value
destSheet.range("E" & lMaxRows + 1).Value = sourceSheet.range("E" & x).Value
destSheet.range("F" & lMaxRows + 1).Value = sourceSheet.range("F" & x).Value
destSheet.range("G" & lMaxRows + 1).Value = sourceSheet.range("G" & x).Value
destSheet.range("H" & lMaxRows + 1).Value = sourceSheet.range("F" & x).Value - sourceSheet.range("G" & x).Value
destSheet.range("I" & lMaxRows + 1).Value = sourceSheet.range("M" & x).Value
destSheet.range("J" & lMaxRows + 1).Value = sourceSheet.range("N" & x).Value
x = x + 1
End If
Loop
End Sub
I can not for the life of me figure out what I did wrong. Any help improving my code would be greatly appreciated!
You are missing an End If ... see below
Sub NameSearch()
Sheets("Raw Data").Unprotect ("29745")
Application.ScreenUpdating = False
Dim x As Long
'set starting point at row 2
x = 2
Dim sourceSheet As Worksheet: Set sourceSheet = ThisWorkbook.Worksheets("Raw Data")
Dim destSheet As Worksheet: Set destSheet = ThisWorkbook.Worksheets("Name Search")
Do While sourceSheet.range("A" & x).Value <> ""
If sourceSheet.range("O" & x).Value <> destSheet.range("B2") Then
x = x + 1
Else
If sourceSheet.range("O" & x).Value = destSheet.range("B2") Then
'selects the next row where the 1st column is empty
lMaxRows = destSheet.Cells(destSheet.Rows.Count, "A").End(xlUp).Row
'pastes the data from the specified cells into the next empty row
destSheet.range("A" & lMaxRows + 1).Value = sourceSheet.range("A" & x).Value
destSheet.range("B" & lMaxRows + 1).Value = sourceSheet.range("B" & x).Value
destSheet.range("C" & lMaxRows + 1).Value = sourceSheet.range("C" & x).Value
destSheet.range("D" & lMaxRows + 1).Value = sourceSheet.range("D" & x).Value
destSheet.range("E" & lMaxRows + 1).Value = sourceSheet.range("E" & x).Value
destSheet.range("F" & lMaxRows + 1).Value = sourceSheet.range("F" & x).Value
destSheet.range("G" & lMaxRows + 1).Value = sourceSheet.range("G" & x).Value
destSheet.range("H" & lMaxRows + 1).Value = sourceSheet.range("F" & x).Value - sourceSheet.range("G" & x).Value
destSheet.range("I" & lMaxRows + 1).Value = sourceSheet.range("M" & x).Value
destSheet.range("J" & lMaxRows + 1).Value = sourceSheet.range("N" & x).Value
x = x + 1
End If
End If '<----MISSING END IF
Loop
End Sub
I'm working on this macro to extract the relavant information from an excel sheet to a new one. But i just can't seem to get it to work and it's making me crazy.
Can you find the error or suggest a better approch?
EDIT: I want to sort through the data in a sheets column c and if it matches my critera (if) i want to match it to the Group (fruit/berry) and also get data from adjecent columns (P,I,R) and take this whole extraxt and add it to a new sheet (ws2)
Private Sub Extract_Click()
Dim ws1, ws2 As Worksheet
Dim i,k as Integer
set ws1 = Workbook.Activesheet
Set ws2 = Worksheets.Add(After:= _
Worksheets(ThisWorkbook.Sheets.Count))
ws2.Name = "Extract" & ThisWorkbook.Sheets.Count
With ws1
i = 10
k = 2
Do While Not Range("C" & i).Value = ""
If Range("C" & i).Value = "Strawberry" Then
ws1.Range("C" & i).Copy
ws2.Range("A" & k).PasteSpecial Paste:=xlPasteValues
ws2.Range("B" & k).Value = "Berry"
ws1.Range("P" & i).Copy
ws2.Range("C" & k).PasteSpecial Paste:=xlPasteValues
ws1.Range("I" & i).Copy
ws2.Range("D" & k).PasteSpecial Paste:=xlPasteValues
ws1.Range("R" & i).Copy
ws2.Range("E" & k).PasteSpecial Paste:=xlPasteValues
ElseIf Range("C" & i).Value = "banana" Then
ws1.Range("C" & i).Copy
ws2.Range("A" & k).PasteSpecial Paste:=xlPasteValues
ws2.Range("B" & k).Value = "Fruit"
ws1.Range("P" & i).Copy
ws2.Range("C" & k).PasteSpecial Paste:=xlPasteValues
ws1.Range("I" & i).Copy
ws2.Range("D" & k).PasteSpecial Paste:=xlPasteValues
ws1.Range("R" & i).Copy
ws2.Range("E" & k).PasteSpecial Paste:=xlPasteValues
End If
k = k+1
i = i +1
Loop
End With
End Sub
I would suggest using a For Loop first of all, and then checking if the cell values match something like:
For i = 2 to lastRow
If Cell(i, columnNumber).value = Cell(i, columnNumber).Value Then
//Do Something
i have a debug in my code, but i cannot figure out why it is happening, could you please review the code and see where i messed up? Note the error debug is happening on the ActiveCell.FormulaR1C1 line.
'ENRICHMENT CODE FOR VARIOUS TITLES
For Each wbtitle In wbrange
sThisWorkTitle = wbtitle
sThisWorkColumnNum = wbtitle.Column
sThisWorkColumnNam = Split(Cells(, sThisWorkColumnNum).Address, "$")(1)
'identifying CASH RADICAL COLUMN LETTER
If sThisWorkTitle = "Account Cash Radical" Then
scashradicalcolumnnam = Split(Cells(, sThisWorkColumnNum).Address, "$")(1)
Else
'do nothing
End If
''' CASH RELATED?
If sThisWorkTitle = "Cash Related?" Then
wbtitle.Select
Range(sThisWorkColumnNam + gspstart).Select
ActiveCell.FormulaR1C1 = Application.WorksheetFunction.VLookup(Range(scashradicalcolumnnam & ActiveCell.Row), Range(scashradicalcolumnnam & immsstart & ":" & scashradicalcolumnnam & immsfinal), 1, False)
ActiveCell.AutoFill Range(ActiveCell.Address, Cells(gspfinal))
Columns(sThisWorkTitle).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Else
'do nothing
End If
Scott has highlighted the problem line.
You could try amending so an actual formula is inserted into the cell.
So instead of the following:
ActiveCell.FormulaR1C1 = _
Application.WorksheetFunction.VLookup( & _
Range(scashradicalcolumnnam & ActiveCell.Row) & _
, Range(scashradicalcolumnnam & immsstart & ":" & scashradicalcolumnnam & immsfinal), 1, False)
Something like:
ActiveCell = "=vlookup(" & scashradicalcolumnnam & ActiveCell.Row & _
"," & scashradicalcolumnnam & immsstart & ":" & _
scashradicalcolumnnam & immsfinal & _
", 1, False)"