This should be simple but I cannot get the examples online to solve my error.
Thanks for your help.
Regards Peter
I have 2 sheets: BOQ and OrderCodes
I am looping through rows in BOQ column"B" and when i find a value I lookup a Named Range in OrderCodes sheet
The Range is called "Lookup_CostCodes"
An example of the Vlookup i require is
Vlookup(1002,LookupCostCodes,3,false)
The relevant code is as follows:
Dim SourceSheet As Worksheet
Dim OrderCodesWs As Worksheet
Dim CostCodesRng As Range
Set OrderCodesWs = ThisWorkbook.Worksheets("OrderCodes")
Set CostCodesRng = OrderCodesWs.Range("Lookup_CostCodes")
On Error GoTo failure
Set sourceSheet = ActiveWorkbook.Sheets("BOQ")
outputRow = START_ROW
Dim sheet As Worksheet
For i = 1 To Range("_7000").row
If Val(sourceSheet.Cells(i, 11).Value) <> 0 And sourceSheet.Cells(i, 11).HasFormula Then
orderRef = sourceSheet.Cells(i, 2)
costCodeValue = Val(sourceSheet.Cells(i, 1))
costCode = Application.WorksheetFunction.VLookup(costCodeValue, "CostCodes!" & CostCodesRng.Address, 3, False)
End If
Next i
On Error GoTo 0
I have wrote the following snippet to address your problem. If this is what you wanted then please do integrate it in your main code.
Public Worksheet As Worksheet
Set Worksheet = Worksheets("BOQ")
Range("B2:B" & lr).Select
For Each cell In Selection
If cell.Value <> "" Then
cell.Offset(columnOffset:=1).Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],Lookup_CostCodes!C[-1]:C[0],2,FALSE)"
Range("B2").Select
End If
Next
Related
Need help with my code please. I want to search all worksheets in a workbook that contain a specific string in its sheet name to copy cell data of a range and paste as values into a different ws. I keep getting Run-Time error '9' subscript out of range. It highlights Set wsSumm = ThisWorkbook.Sheets("Summary") as the reasoning. I have a Summary tab so I am unsure why it is giving this error.
What I ultimately need to do is take data from A2 of all BL ws and paste into Column A of Summary ws. Then take A1 of all SL ws and paste into Column B of Summary ws. I would need to paste as values. My sheets are named 1-15 as BL, SL (BL1, SL1, BL2, SL2, BL3, SL3, ect) and a Summary ws. Below is what my Workbook looks like and the Code I am using.
[enter image description here][1]
Option Explicit
Sub Macro1()
Dim wsSumm As Worksheet, ws As Worksheet
Dim strCol As String
Dim lngRow As Long
Application.ScreenUpdating = False
Set wsSumm = ThisWorkbook.Sheets("Summary") '<-Sheet name for the data to be concolidated. Change to suit.
For Each ws In ThisWorkbook.Sheets
If ws.Name <> wsSumm.Name Then
strCol = IIf(StrConv(Left(ws.Name, 2), vbUpperCase) = "BL", "A", "B")
lngRow = IIf(StrConv(Left(ws.Name, 2), vbUpperCase) = "BL", 2, 1)
wsSumm.Range(strCol & Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Range("A" & lngRow)
End If
Next ws
Application.ScreenUpdating = True
End Sub
I have created a spreadsheet with a sheet 1 input table, and want to transfer/copy that data into a sheet 2 log table. The input table on sheet 1 will have an inspection date and an inspection name cells. What I am having an issue with is that I can get the first line of the log to input, but the 2nd line I get a "Run0time error '1004': Application-defined or object defined error". Not sure what to look at from here.
Here's my code (I know, it's stiff rough and needs to be cleaned up):
Private Sub Add_Click()
Dim InspectionDate As String, InspectionName As String
Dim LastRow As Long
Worksheets("sheet1").Select
InspectionDate = Range("B4")
InspectionName = Range("B5")
Worksheets("sheet2").Select
Worksheets("sheet2").Range("B3").Select
If Worksheets("sheet2").Range("B3").Offset(1, 0) <> "" Then
Worksheets("sheet2").Range("B3").End(x1Down).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = InspectionDate
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = InspectionName
Worksheets("sheet1").Select
Worksheets("sheet1").Range("B4:B5").ClearContents
End Sub
Two main reasons why .Select, .Activate, Selection, Activecell, Activesheet, Activeworkbook, etc. should be avoided
The reasons are explained in the second answer on that page.
I have tested the code below and it works for me.
I'm autistic; so sometimes I appear to school others, when I'm only trying to help.
Option Explicit
Private Sub Add_Click()
Dim InspectionDate$, InspectionName$
Dim LastRow&
Dim WS As Worksheet, WS2 As Worksheet
Set WS = Worksheets("sheet1")
Set WS2 = Worksheets("sheet2")
InspectionDate = WS.Range("B4")
InspectionName = WS.Range("B5")
LastRow = 3
If WS2.Range("B" & LastRow + 1) <> "" Then
LastRow = WS2.Range("B" & Rows.count - 1).End(xlUp).Row
End If
WS2.Cells(LastRow + 1, 2) = InspectionDate
WS2.Cells(LastRow + 1, 3) = InspectionName
WS.Range("B4:B5").ClearContents
End Sub
I'm learning VBA in Excel 2013 and I posted a question last weekend but didn't receive a response. I've been working on the code more and narrowed the error down to one. I'm trying to highlight a row in a workbook if a value in column A is found in the column A another open workbook.
I get a Runtime error 13: Type mismatch error. That is all that it says and it is for this line of code:
If cell.Value = valuetofind Then
I have looked on numerous sites about this error but I don't see any that match my situation. I think it's b/c 'valuetofind' is a range and it's trying to set a range equal to a value, seen in 'cell.value'. I think all of my variables are declared properly.
I've tried changing it to below so that they are both ranges but that gives the same error:
If cell = valuetofind Then...
Can anyone help with this error?
Sub HighlightRow()
'http://www.vbaexpress.com/forum/showthread.php?26162-Solved-Highlight-ROW-based-on-cell-value
'http://www.mrexcel.com/forum/excel-questions/827262-visual-basic-applications-vlookup-between-2-workbooks.html
'test column just picks any column, I think, to test how far down the rows go to, I think you could choose any column
Const TEST_COLUMN As String = "D" '<=== change to suit
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LastRow As Long
Dim cell As Range
Dim valuetofind As Range
Set ws1 = ThisWorkbook.Sheets(1) 'name will change each day
Set ws2 = ActiveWorkbook.Sheets(1) 'name will change each day
With ws1
LastRow = Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
'LastRow is testing/finding out last row using TEST_COLUMN first before performs rest of macro
End With
Set valuetofind = ws2.Range("A2:A" & LastRow)
'Range("A2:A" & LastRow) is the criteria row where it is looking for Break Down and PM/SM Call below
'Resize(,7) will highlight the row however many columns you tell it to, in this case 7
'cell.Offset(, -6) I think tells to go back 6 columns to column A and start the highlighting there
With ws1
For Each cell In Range("A2:A" & LastRow)
If cell.Value = valuetofind Then
'old, do not use: wb2.Worksheets(wb2SheetName).Range("A2:A" & LastRow)
cell.Offset(, -6).Resize(, 7).Interior.ColorIndex = 39
Else
cell.EntireRow.Interior.ColorIndex = xlNone
End If
Next
End With
End Sub
The code has been altered and is working for anyone who needs help.
This is modified from Dinesh Takyar's video on copying data between worksheets(https://www.youtube.com/watch?v=AzhQ5KiNybk_), though this code below is to highlight rows between workbooks. Both workbooks, destination and source workbooks, need to be open.
I believe the original Run Time 13 Error was b/c the criteria, original variable called 'valuetofind' was Dim as Range, when it is a String. The variable in the code below is now called 'myname' and is Dim as String. But I don't believe the code above would have worked anyway b/c I needed the For/Next to go through each cell in my criteria column.
Thanks to Dinesh and people on this forum.
Sub HighlightRowBtwWorkbook()
Dim wkbkDest As Workbook
Dim i As Long
Dim lastrowDest As Long
Dim lastcolDest As Long
Dim wkbkSource As Workbook
Dim j As Long
Dim lastrowSource As Long
Dim myname As String
Dim lastcolSource As Long
'Destination
Set wkbkDest = ThisWorkbook 'was Workbooks("Destination_VBAHighlight.xlsm") 'was ActiveWorkbook
lastrowDest = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lastcolDest = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lastrowDest
myname = wkbkDest.ActiveSheet.Cells(i, "A").Value
'Source
Set wkbkSource = Workbooks("TESTVBA.xlsm")
wkbkSource.Activate
lastrowSource = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lastcolSource = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For j = 2 To lastrowSource
If ActiveSheet.Cells(j, "A").Value = myname Then
'Activate Destination
wkbkDest.Sheets(1).Activate
ActiveSheet.Range(Cells(i, "B"), Cells(i, lastcolDest)).Interior.Color = RGB(252, 228, 214)
End If
Next j
Next i
'select cell A1 in Destination wkbk to end there
wkbkDest.Sheets(1).Activate
wkbkDest.ActiveSheet.Range("A1").Select
End Sub
I have a Pivot table whose row number could change depending on the data. I want to copy the pivot table and paste it as values starting from column B in another existing sheet.
To do this, i first tried getting the name of the pivot and stored it in a named range using the following code:
Sub ListPivotsInfor()
Dim St As Worksheet
Dim NewSt As Worksheet
Dim pt As PivotTable
Dim I, K As Long
Application.ScreenUpdating = False
Set NewSt = Worksheets.Add
ActiveSheet.Name = "ListOfPivotTables"
I = 1: K = 2
With NewSt
.Cells(I, 1) = "Name"
.Cells(I, 2) = "Sheet"
.Cells(I, 3) = "Location"
For Each St In ActiveWorkbook.Worksheets
For Each pt In St.PivotTables
I = I + 1
.Cells(I, 1).Value = pt.Name
.Cells(I, 2).Value = St.Name
.Cells(I, 3).Value = pt.TableRange1.Address
Next
Next
.Activate
End With
Application.ScreenUpdating = True
Dim cell As Range
Dim rng As Range
Dim RangeName As String
Dim CellName As String
'Single Cell Reference (Workbook Scope)
RangeName = "PivotName"
CellName = "A2"
Set cell = Worksheets("ListOfPivotTables").Range(CellName)
ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=cell
I later tried to copy the pivot table and paste it in another sheet using the following code:
Worksheets.Add
ActiveSheet.Name = "GEP"
Worksheets("GEP Write").PivotTables(PivotName).TableRange2.Copy Destination:=Worksheets("GEP").Range("B1")
The last line is throwing a "Run time error 1004: Unable to get the PivtoTables property of the worksheet class".
Appreciate any help.
Regards
I am currently coding a loop in VBA and for some reason it only works until the first "If" statement is true. After that, it also applies the macro to cells that are FALSE. I just don't find the cause of this. In my example, operations 1.-3. should only be performed for x = 12 and x = 25 yet the code performes the macro for all x >= 12 and x <= 25
I've been trying for a good three hours now to fix this code and find an answer somewhere on the Internet... :-( Would be very happy if you could help! Thanks a lot in advance!
Sub CreateReport()
Dim lastrow As Long
Dim x As Long
lastrow = Sheets("Overview").Cells(Rows.Count, 1).End(xlUp).Row
For x = 10 To lastrow
If ActiveSheet.Range("A" & x).EntireRow.Hidden = False Then
'1. Copy sheet once per visible row
Sheets("Master").Select
Sheets("Master").Copy After:=Sheets(Sheets.Count)
'2. Paste company name
ActiveSheet.Cells(4, 1).Value = Sheets("Overview").Cells(x, 1).Value
'3. Name worksheet after company name
ActiveSheet.Name = Cells(4, 1).Value
End If
Next x
End Sub
This is a case study as to why "ActiveSheet" should not be used. The problem is that you set the newly created sheet sheet as the "ActiveSheet", so it starts checking the newly created sheet to see if any rows are hidden, and they aren't. Specify the variables:
Sub CreateReport()
Dim wb As Workbook
Dim overviewSheet As WorkSheet
Dim newSheet As Worksheet
Dim masterSheet As Worksheet
Dim lastrow As Long
Dim x As Long
Set wb = ThisWorkbook
Set overviewSheet = wb.Sheets("Overview")
Set masterSheet = wb.Sheets("Master")
lastrow = overviewSheet.Cells(overviewSheet.Rows.Count, 1).End(xlUp).Row
For x = 10 To lastrow
If overviewSheet.Range("A" & x).EntireRow.Hidden = False Then
'1. Copy sheet once per visible row
masterSheet.Copy After:=wb.Sheets(wb.Sheets.Count)
Set newSheet = wb.Sheets(wb.Sheets.Count)
'2. Paste company name
newSheet.Cells(4, 1).Value = overViewSheet.Cells(x, 1).Value
'3. Name worksheet after company name
newSheet.Name = Cells(4, 1).Value
End If
Next x
End Sub