Please help to advise where did it went wrong. Would like to create a vba vlookup for a different workbook
Sub Executelookup1()
Dim wb As Workbook
Dim rng As Range
Workbooks.Open ("V:\Finance\Systems-Risk-ERM\OrderToCash\C2C\Corp Credit Control\3. Monthly Combined Aging\2022\Apr22\Top Segments & Top All _Apr22.xlsx")
Set ws = Sheet3
Set wb = ActiveWorkbook
ThisWorkbook.Activate
Set rng = ws.Range("K2", ws.Cells(ws.Rows.Count, "K").End(xlUp))
Dim i As Integer
For i = 2 To rng
'On Error Resume Next
Range("K" & i).Value = WorksheetFunction.VLookup(Range("F" & i).Value, wb.Sheets("TopSegments").Range("F:J"), 5, 0)
Next i
End Sub
I would like to have the end product to look like the picture displayed below.
Related
I made this Excel form that looks like this (just an example) in Sheet1:
And I want to link the data in C5, C6, C7, or in other columns, to Sheet Data, where I have columns like this:
What I want is when a user fills the form and clicked submit, the data from the form will be linked to sheet Data and make a new row every time a new data from the form is submitted.
This is what I did so far, but this code doesn't work correctly:
Sub Submit_Form()
Dim LastRow As Long, ws As Worksheet
Set ws = Sheets("Data")
LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row + 1
ws.Range("B" & LastRow).Value = Worksheets("Sheet1").C5
ws.Range("C" & LastRow).Value = Worksheets("Sheet1").C6
ws.Range("D" & LastRow).Value = Worksheets("Sheet1").C7
ws.Range("E" & LastRow).Value = Worksheets("Sheet1").C8
End Sub
The error message said: Runtime Error 438: Object doesn't support this property or method.
Anybody can help with this problem? Any help is greatly appreciated. Thanks!
You can do it in one line using WorksheetFunction.Transpose()
Option Explicit
Public Sub Submit_Form()
Dim ws As Worksheet
Set ws = Sheets("Data")
Dim LastRow As Long
LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row + 1
Dim SourceRange As Range
Set SourceRange = Worksheets("Sheet1").Range("C5:C8")
ws.Cells(LastRow, "B").Resize(ColumnSize:=SourceRange.Rows.Count).Value = Application.WorksheetFunction.Transpose(SourceRange)
SourceRange.ClearContents 'clear form
End Sub
To add more cells that don't need to be transposed you can add them like that:
Option Explicit
Public Sub Submit_Form()
Dim wsDest As Worksheet
Set wsDest = Worksheets("Data")
Dim LastRow As Long
LastRow = wsDest.Range("B" & Rows.Count).End(xlUp).Row + 1
Dim wsSrc As Worksheet
Set wsSrc = Worksheets("Sheet1")
Dim TransposeRange As Range
Set TransposeRange = wsSrc.Range("C5:C8")
wsDest.Cells(LastRow, "B").Resize(ColumnSize:=TransposeRange.Rows.Count).Value = Application.WorksheetFunction.Transpose(TransposeRange)
wsDest.Cells(LastRow, "F").Value = wsSrc.Range("G5")
wsDest.Cells(LastRow, "G").Value = wsSrc.Range("H7")
'clear form
TransposeRange.ClearContents
wsSrc.Range("G5,H7").ClearContents
End Sub
You are almost there:
ws.Range("B" & LastRow).Value = Worksheets("Sheet1").C5
Should change to :
ws.Range("B" & LastRow).Value = Worksheets("Sheet1").Range("C5").value
For your second Form to clear the contents you can simply do it like this:
Sub Clearform()
Worksheets("Sheet1").Range("C5:C8,G8,H7").clearcontents
End Sub
I have two Excel worksheets with numerical ids in. I wish to compare list one against list two and where matches are found return the respective cell addresses for each match.
I am able via VBA to look through each list and return the address of the match in the small list but not of the match found in the larger list.
Any help would be appreciated. I guess the reality is that the message of the address it currently displays is simply the next cell in the loop.
Sub FindMatchAddress()
Dim ws As Worksheet
Dim wsInp As Worksheet
Dim wsRD As Worksheet
Dim rngInp As Range
Dim rngRD As Range
Set wsInp = Worksheets("Sheet1")
Set wsRD = Worksheets("Sheet2")
Set rngInp = wsInp.Range("B2:B11")
For Each cell In rngInp
If IsError(Application.Match(cell, rngRD, 0)) Then
Else
MsgBox cell.Address
cell.Offset(, 12) = "Found"
End If
Next cell
End Sub
Thank you.
What about using Range.Find? And also setting rngRd as pointed out in the comments.
Option Explicit
Sub FindMatchAddress()
Dim ws As Worksheet
Dim wsInp As Worksheet
Dim wsRD As Worksheet
Dim rngInp As Range
Dim rngRD As Range
Dim rng As Range, tmpRng As Range
Set wsInp = Worksheets("Sheet1")
Set wsRD = Worksheets("Sheet2")
Set rngInp = wsInp.Range("B2:B11")
Set rngRD = wsInp.Range("D2:D16")
For Each rng In rngInp
Set tmpRng = rngRD.Find(What:=rng.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not tmpRng Is Nothing Then
MsgBox tmpRng.Address
rng.Offset(, 12) = "Found"
End If
Next rng
End Sub
Phil, reading into your question, I'm taking for granted that the "numerical ids" are in the same column but on different worksheets. If I'm correct then, the below code should work as is. The code finds matching values in worksheet2 and instead of just placing just "Found" in worksheet1, "column N", I add worksheet2's name and the cell address. if your "numerical ids" are in different columns, please change the ws2 column letter to suit you. I've tested it on mock data and it works fine. I've tried to keep it as simple as I could.
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Dim lRow1 As Long
lRow1 = ws1.Range("B" & Rows.Count).End(xlUp).Row
Dim lRow2 As Long
lRow2 = ws2.Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lRow1
For j = 2 To lRow2
If ws1.Range("B" & i).Value = ws2.Range("B" & j).Value Then
ws1.Range("B" & i).Offset(, 12).Value = "Found: " & ws2.Name & "." & ws2.Range("B" & j).address
End If
Next j
Next i
I have a workbook which has multiple worksheets that vary in name but the content structure of each sheet remains the same. There is only one sheet name that is always constant pie.
I am trying to apply a formula in cell N2 and then copy the formula down to the last active row in all the worksheets except the one named pie
The code I have so far is works for one loop but then i get an error "AutoFill method of Range Class failed"
I have used
Lastrow = Range("M" & Rows.Count).End(xlUp).Row
to determine the last row as column M is always complete.
Any help to complete this would be very much appreciated
Code i have is:
Sub ConcatForm()
Dim wSht As Worksheet
Lastrow = Range("M" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For Each wSht In Worksheets
If wSht.Name <> "Pie" Then
wSht.Range("N2").FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2],RC[-1])"
wSht.Range("N2").AutoFill Destination:=Range("N2:N" & Lastrow)
End If
Next wSht
Application.ScreenUpdating = True
End Sub
You don't need to use Autofill to achieve this.
Just apply your formulas directly to your range and use relative references, i.e. K2, rather than absolute references, i.e. $K$2. It will fill down and update the formula for you.
Make sure you are fully qualifying your references. For example, see where I have used ThisWorkbook and the update to how lastrow is initialized. Otherwise, Excel can get confused and throw other errors.
Your lastrow variable hasn't been dimensioned so it is an implicit Variant. You'd be better off dimensioning it explicitly as a Long.
Sub ConcatForm()
Application.ScreenUpdating = False
Dim wSht As Worksheet
Dim lastrow As Long
With ThisWorkbook.Worksheets("Sheet1") 'which worksheet to get last row?
lastrow = .Range("M" & .Rows.Count).End(xlUp).Row
End With
For Each wSht In ThisWorkbook.Worksheets
If wSht.Name <> "Pie" Then
wSht.Range("N2:N" & lastrow).Formula = "=CONCATENATE(K2,L2,M2)"
End If
Next wSht
Application.ScreenUpdating = True
End Sub
you were just one wSht reference away from the goal:
Sub ConcatForm()
Dim wSht As Worksheet
lastRow = Range("M" & Rows.count).End(xlUp).row '<--| without explicit worksheet qualification it will reference a range in the "active" sheet
Application.ScreenUpdating = False
For Each wSht In Worksheets
If wSht.Name <> "Pie" Then
wSht.Range("N2").FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2],RC[-1])"
wSht.Range("N2").AutoFill Destination:=wSht.Range("N2:N" & lastRow) '<--| this will reference a range in 'wSht' worksheet
End If
Next
Application.ScreenUpdating = True
End Sub
Use following sub...
Sub ConcatForm()
Dim wSht As Worksheet
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For Each wSht In Worksheets
With wSht
If .Name <> "Pie" Then
.Select
.Range("N2").FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2],RC[-1])"
.Range("N2").AutoFill Destination:=Range("N2:N" & Lastrow)
End If
End With
Next wSht
Application.ScreenUpdating = True
End Sub
I am attempting to copy column A starting in row 2 on "Sheet1" and paste it in Column C on sheet "ABC" starting at row 5. The number of rows in Column A is variable so I cannot use a fixed range.
The code below does what I need, but I am trying to avoid using .Select and .Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet1").Range("A2:A" & LastRow).Copy
Sheets("ABC").Activate
Sheets("ABC").Range("C5:C" & LastRow).Select
Selection.PasteSpecial xlPasteValues
I tried setting the columns equal to one another using this code:
Sheets("ABC").Range("C5").End(xlDown).Value=Sheets("Sheet1").Range("A2:A" & LastRow).Value
This runs without error but it "does nothing" -- No data appears on worksheet "ABC"
I also tried to following:
Dim WS As Worksheet
Dim wsABC As worksheet
Set WS = Sheets("Sheet1")
Set wsABC = Sheets("ABC")
LastRow = Range("A" & Rows.Count).End(xlUp).Row
WS.Range("A2:A" & LastRow).Copy
wsABC.Range("C5").End(xlDown).Paste
This produces a "Run-time error #438 Object doesn't support this property or method" Error on this line:
wsABC.Range("C5").End(xlDown).Paste
Another method I tried was as follows:
Dim WS As Worksheet
Set WS = Sheets("Sheet1")
Set wsABC = Sheets("ABC")
With WS
LastRow = Range("A" & Rows.Count).End(xlUp).Row
WS.Range("A2:A" & LastRow).value = wsABC.Range("C5:C & LastRow").Value
End With
This produces a "Run-time error '1004' Application-defined or object defined error.
I am open to corrections / comments on any of my attempts, I just want to avoid using .Select and .Activate.
Thank you in advance for your time and assistance!
Coding styles can vary greatly. Here's one way to do what you're looking for:
Sub tgr()
Dim wb As Workbook
Dim wsData As Worksheet
Dim wsDest As Worksheet
Set wb = ActiveWorkbook
Set wsData = wb.Sheets("Sheet1")
Set wsDest = wb.Sheets("ABC")
With wsData.Range("A2", wsData.Cells(wsData.Rows.Count, "A").End(xlUp))
wsDest.Range("C5").Resize(.Rows.Count).Value = .Value
End With
End Sub
With Worksheets("Sheet 1")
With .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
Worksheets("ABC").Range("C5").Resize(.Rows.Count).Value = .Value
End With
End With
Newbie at vba here. I'm trying to apply a simple For Each loop (which nullifies cells < 0) to all worksheets in the workbook by nesting this inside another For Each loop.
When I try and run my code below I get an error and I'm not sure if it has anything to do with having worksheet as a variable within a Set statement.
Can't seem to figure this out/find a solution.
Thanks
Sub deleteNegativeValue()
Application.DisplayAlerts = False
Dim lastRow As Long
Dim ws As Worksheet
Dim cell As Range
Dim res As Range
For Each ws In Workbooks(1).Worksheets
Set res = ws.Range("1:1").Find("Value", lookat:=xlPart)
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Range(ws.Cells(1, res.Column), ws.Cells(lastRow, res.Column))
If cell < 0 Then cell = ""
Next
Next
End Sub
Try this:
Sub deleteNegativeValue()
Dim lastRow As Long
Dim ws As Worksheet
Dim cell As Range
Dim res As Range
For Each ws In ThisWorkbook.Worksheets
Set res = ws.Range("1:1").Find("Value", lookat:=xlPart)
lastRow = ws.Range("A" & Rows.Count).End(xlUp).row
If Not res Is Nothing Then
For Each cell In ws.Range(ws.Cells(1, res.Column), ws.Cells(lastRow, res.Column))
If cell < 0 Then cell = ""
Next
Else
MsgBox "No Value found on Sheet " & ws.Name
End If
Next
End Sub
There needs to be a check on the Find method, to ensure that something was found
you could try this
Option Explicit
Sub deleteNegativeValue()
Dim ws As Worksheet
Dim res As Range
For Each ws In ThisWorkbook.Worksheets
Set res = Intersect(ws.Rows(1), ws.UsedRange).Find("value", LookAt:=xlPart)
If Not res Is Nothing Then
ws.Columns(res.Column).SpecialCells(xlCellTypeConstants, xlNumbers).Replace What:="-*", Replacement:="", SearchOrder:=xlByColumns, MatchCase:=False, LookAt:=xlWhole
Else
MsgBox "No Value found on Sheet " & ws.Name
End If
Next
End Sub
which should run faster since it doesn't iterate through every cell of each column and restrict the Find method range to the used one instead of the entire row.
the only warning is that the first row of all searched in sheets must not be empty...
Try the second for-each this way:
ws.Range(ws.Cells(1, res.Column), ws.Cells(lastRow, res.Column))