I have the following code:
Private Sub submitFormBtn_Click()
If timeOfArrival.Value = "" Then
MsgBox "Please enter time of arrival", vbCritical
ElseIf poNumber.Value = "" Then
MsgBox "Please enter a valid PO Number", vbCritical
Else
Dim lRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Data")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Cells(lRow, 1).Value = Me.DTPicker1.Value
.Cells(lRow, 2).Value = Me.timeOfArrival.Value
.Cells(lRow, 4).Value = Me.poNumber.Value
.Cells(lRow, 5).Value = "=LookupCSVResults(D3,Table_PurchaseOrderLine[POR],Table_PurchaseOrderLine[Product])"
End With
End If
End Sub
What it does
The code above, takes in the User Form Text Box values, and then inserts it into excel sheet for each available row.
Problem
This function "=LookupCSVResults(D3,Table_PurchaseOrderLine[POR],Table_PurchaseOrderLine[Product])" is the complication.
For every record inserted into Excel sheet, it is currently referencing to cell D3 - how can I reference it to the cell to the left of it?
Current problem:
Should be:
If I understand correctly, you want to use lrow:
"=LookupCSVResults(D" & lrow & ",Table_PurchaseOrderLine[POR],Table_PurchaseOrderLine[Product])"
Related
I have an excel file automated with a macro. I have a userform interface (see photo below). Inside the userform is a combobox and a textbox.
I want to add something in the worksheet but depending on what type of expenses it is and I don't understand what is wrong in my code below. What I want is if I add something in the column of "taxi" (2nd row), I can also in "carwash" (2nd row) but it appears to a different result. I am also not able to add data on 3rd, 4th, 5th rows and so on.
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'find first empty row in database
Set rngNullString = Intersect(ws.Columns("A"), ws.Columns("A")).Find("")
If rngNullString.row < ws.Cells(ws.Rows.Count, "A").End(xlUp).row Then
Set rngNullString = Intersect(ws.Columns("A"), _
ws.Columns("A")).SpecialCells(xlCellTypeBlanks)
End If
iRow = rngNullString.row
'check for Name number
If Trim(Me.TextBox1.value) = "" Then
Me.TextBox1.SetFocus
MsgBox "Please complete the FORM"
Exit Sub
End If
'copy the data to the database
If Me.ComboBox1.value = "Taxi" Then
ws.Cells(iRow, 1).value = Me.ComboBox1.value
ws.Cells(iRow, 2).value = Me.TextBox1.value
End If
If Me.ComboBox1.value = "Carwash" Then
ws.Cells(iRow, 3).value = Me.ComboBox1.value
ws.Cells(iRow, 4).value = Me.TextBox1.value
End If
MsgBox "Sucessfully! Data added", vbOKOnly + vbInformation, "Data Notification"
'clear the data
Me.TextBox1.value = ""
Me.ComboBox1.value = ""
Me.TextBox1.SetFocus
Unload Me
End Sub
Let me preface this with saying fairly new to VBA.
But I've created a Userform that is taking in First Name, Last Name and Job Title.
Looking to correlate training to job title.
Code references named ranges (1)Merge_Title and (2)Merge_Training from the Merged_DF.
The error I'm encountering is seen in 'Results' pic below. Looking to simply have name, job, and all relevant training associated to that job (ref. Merge_DF pic).
Any help is much appreciated.
Thanks again!
Merge_DF Pic
Results
''' Submits userform into table
Dim lRow As Long
Dim lJob As Long
Dim ws As Worksheet
Dim ws_Merge As Worksheet
Set ws = Worksheets("DATA")
Set ws_Merge = Worksheets("MERGE_DF")
'find first empty row in table
lRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
lJob = Me.CmboJob.ListIndex
'verify data entered
If Trim(Me.TextFirst.Value) = "" Then
Me.TextFirst.SetFocus
MsgBox "You Forgot the First Name"
Exit Sub
End If
If Trim(Me.TextLast.Value) = "" Then
Me.TextLast.SetFocus
MsgBox "You Forgot the Last Name"
Exit Sub
End If
If Trim(Me.CmboJob.Value) = "" Then
Me.CmboJob.SetFocus
MsgBox "You Forgot the Job Title"
Exit Sub
End If
'loops and records data
For Each c In ws_Merge.Range("Merge_Title")
If c = Me.CmboJob.Value Then
With ws
.Cells(lRow, 1).Value = Me.TextLast.Value
.Cells(lRow, 2).Value = Me.TextFirst.Value
.Cells(lRow, 4).Value = Me.CmboJob.Value
For Each i In ws_Merge.Range("Merge_Training")
ws.Cells(lRow, 7).Value = i.Value
lRow = lRow + 1
Next
' lRow = lRow + 1
End With
End If
Next c
Me.TextLast.Value = ""
Me.TextFirst.Value = ""
Me.CmboJob.Value = ""
Me.CmboJob.SetFocus
End Sub
first time asker here.
I found a nice VBA code to copy the same specific cells from multiple worksheets into a mastersheets and actually does its job (i don't remember where I founf it originally). The only small issue is that it starts to input the data from cell A2, while I would like it to start from cell A4.
Here is the code:
Sub ListFB()
Sheets("Master").Range("A4").Value = "Sheet Name"
For I = 1 To ThisWorkbook.Worksheets.Count
If Sheets(I).Name <> "RiassuntoTEST" Then
Sheets("Master").Cells(I, 1).Value = Sheets(I).Range("B2").Value
Sheets("Master").Cells(I, 2).Value = Sheets(I).Range("C2").Value
Sheets("Master").Cells(I, 3).Value = Sheets(I).Range("C10").Value
Sheets("Master").Cells(I, 4).Value = Sheets(I).Range("C11").Value
Sheets("Master").Cells(I, 5).Value = Sheets(I).Range("C15").Value
Sheets("Master").Cells(I, 6).Value = Sheets(I).Range("C16").Value
Sheets("Master").Cells(I, 7).Value = Sheets(I).Range("C20").Value
Sheets("Master").Cells(I, 8).Value = Sheets(I).Range("C21").Value
Sheets("Master").Cells(I, 9).Value = Sheets(I).Range("C25").Value
Sheets("Master").Cells(I, 10).Value = Sheets(I).Range("C26").Value
Sheets("Master").Cells(I, 11).Value = Sheets(I).Range("C29").Value
Sheets("Master").Cells(I, 12).Value = Sheets(I).Range("C30").Value
Sheets("Master").Cells(I, 13).Value = Sheets(I).Range("C33").Value
Sheets("Master").Cells(I, 14).Value = Sheets(I).Range("C34").Value
End If
Next I
End Sub
What I think it does is take value B2 from Sheet I and copy it to A2 of the mastersheet, then take C2 and copy it to B2, until it has all the required data from that sheet into the same rows, then goes to the next sheet and puts the data in the next rows. As I said above, I would like that this whole process starts from A4 instead of A2.
I am fairly new to this kind of stuff so any input and help is appreciated.
Also, does the row
Sheets("Master").Range("A4").Value = "Sheet Name"
Do anything for my purpose at all?
Thank you!
First issue:
Sheets("RiassuntoTEST").Cells(I, 1).Value
Cells holds what is known as an R1C1 reference. Meaning Row number, Column number. Since this line I = 1 To ThisWorkbook.Worksheets.Count counts from 1 to the number of worksheets you have, this will start pasting in row 1, column 1, also known as cell A1. If you want to up this to cell A4 instead, you will need to increase this by 3 like so:
Sheets("RiassuntoTEST").Cells(I + 3, 1).Value
You will need to do this on every line.
Second issue:
Also, does the row
Sheets("RiassuntoTEST").Range("A4").Value = "Nome Foglio"
Do anything for my purpose at all?
No, it does not, as stated before, your code will (now) start pasting at cell A4, so as soon as the second block starts running, this is overwritten.
I rewrote your code in such a way as to enable you to make all the amendments you might want - perhaps with a little help from the comments I inserted between the lines of code.
Option Explicit
Sub UpdateMaster()
' Variatus #STO 23 Jan 2020
Dim Wb As Workbook
Dim MasterWs As Worksheet
Dim Ws As Worksheet
Dim SourceCell() As String
Dim Rt As Long ' target row
Dim Ct As Long ' target column
Dim i As Integer
Set Wb = ThisWorkbook ' you might specify another workbook
' specify the Master worksheet here
Set MasterWs = Wb.Worksheets("TEST")
' list all the source cells here
SourceCell = Split("B2,C2,C10,C11,C15,C16,C20,C21,C25,C26,C29,C30,C33,C34", ",")
Rt = 4 ' set first row to write to here
With MasterWs
' keep contents in rows 1 to 3 (incl title)
.Range(.Cells(Rt, 1), .Cells(.Rows.Count, "A").End(xlUp) _
.Offset(0, UBound(SourceCell) + 1)) _
.ClearContents
End With
Application.ScreenUpdating = False ' speeds up execution
For i = 1 To Wb.Worksheets.Count
Set Ws = Wb.Worksheets(i)
If Not Ws Is MasterWs Then
For Ct = 0 To UBound(SourceCell)
MasterWs.Cells(Rt + i - 1, Ct + 1) = Ws.Range(Trim(SourceCell(Ct))).Value
Next Ct
End If
Next i
Application.ScreenUpdating = True
End Sub
I have a master price worksheet (Test Price) with product name (col A) and price (col B). I want to create a macro that when you click a button it will update the prices through the entire workbook. The previous person in my position already created a MOD that will update prices throughout the WB if it is changed in one WS. I am trying to link the master list to that code. So loop through the list and update one sheet which will use the existing mod to update all other sheets. Can anyone please help with this?
This is the code that updates the sheets, I need to link the master price list to this:
Sub ChangePrice(row As String, price As String)
Dim cropVal As String: cropVal = Cells(row, 2).Value ' inefficient
Dim LastRow As Long
For Each ws In ActiveWorkbook.Worksheets
'simple check for division in A3 (stronger check may be needed)
If ws.Cells(3, 1).Value = "Division:" Then
LastRow = ws.Range("A" & Rows.count).End(xlUp).row
' starts in row 12, though data starts in 13
For i = 12 To LastRow
'check column 2 if crop is the same
If ws.Cells(i, 2).Value = cropVal Then
'if so, change its price in column 10
ws.Cells(i, 10).Value = price
'this handles situations where the symbol is attached
ElseIf ws.Cells(i, 2).Value = cropVal & "®" Then
ws.Cells(i, 10).Value = price
End If
Next i
End If
Next ws
End Sub
You could create a dictionary of the values and then pass the dictionary to the module. You would need to add a For Each loop to your master sheet to find the row with the product for each specific worksheet.
Sub CropValFind()
Dim ProdCol As Range, Cell As Range, PriceCol As Range
Set ProdCol = 'Your product column range here
Set PriceCol = 'Your Price Column range here
For Each Cell in ProdCol
Call ChangePrice(Cell.Value, CreateDictFromColumns("MasterSheetName", ProdCol.Column, PriceCol.Column))
Next
End Sub
Assuming your product and price columns are adjacent to each other and the values are strings:
Pulled from https://stackoverflow.com/a/33523909/10462532
Function CreateDictFromColumns(sheet As String, keyCol As String, valCol As String) As Dictionary
Set CreateDictFromColumns = New Dictionary
Dim rng As Range: Set rng = Sheets(sheet).Range(keyCol & ":" & valCol)
Dim i As Long
Dim lastCol As Long '// for non-adjacent ("A:ZZ")
lastCol = rng.Columns.Count
For i = 1 To rng.Rows.Count
If (rng(i, 1).Value = "") Then Exit Function
CreateDictFromColumns.Add rng(i, 1).Value, rng(i, lastCol).Value
Next
End Function
Then your ChangePrice Sub would look something like this.
Sub ChangePrice(row As String, price As Dictionary)
Dim cropVal As String: cropVal = row
Dim LastRow As Long
For Each ws In ActiveWorkbook.Worksheets
'simple check for division in A3 (stronger check may be needed)
If ws.Cells(3, 1).Value = "Division:" Then
LastRow = ws.Range("A" & Rows.count).End(xlUp).row
' starts in row 12, though data starts in 13
For i = 12 To LastRow
'check column 2 if crop is the same
If ws.Cells(i, 2).Value = cropVal Then
'if so, change its price in column 10
ws.Cells(i, 10).Value = price(row)
'this handles situations where the symbol is attached
ElseIf ws.Cells(i, 2).Value = cropVal & "®" Then
ws.Cells(i, 10).Value = price(row)
End If
Next i
End If
Next ws
End Sub
A great resource to learn the in's and outs of dictionaries can be found here.
I have the below macro which inserts an array of data on each alternative row.
This works well, however, my data changes all the time so it is not the best method.
Sub inserttexteveryonerow()
Dim Last As Integer
Dim emptyRow As Integer
Last = Range("A" & Rows.Count).End(xlUp).Row
For emptyRow = Last To 2 Step -1
If Not Cells(emptyRow, 1).Value = "" Then
Rows(emptyRow).Resize(1).insert
Range(Cells(emptyRow, "A"), Cells(emptyRow, "F")).Value = Array("COLA", "COLB", "COLC", "COLD", "COLD", "COLF")
End If
Next emptyRow
End Sub
I want to have my data on Sheet1, but my alternate insert row on Sheet2 which has the specific data.
How can I edit this row:
Range(Cells(emptyRow, "A"), Cells(emptyRow, "F")).Value = Array("COLA", "COLB", "COLC", "COLD", "COLD", "COLF")
From inserting specific data to inserting the range on SHEET2 rows A1 to AF?
Assuming your request is to insert the range on Sheet2 from cell A1 to cell F1, the following should work:
Sub inserttexteveryonerow()
Dim Last As Integer
Dim emptyRow As Integer
Last = Range("A" & Rows.Count).End(xlUp).Row
For emptyRow = Last To 2 Step -1
If Not Cells(emptyRow, 1).Value = "" Then
Rows(emptyRow).Resize(1).insert
Range(Cells(emptyRow, "A"), Cells(emptyRow, "F")).Value = Worksheets("Sheet2").Range("A1:F1").Value
End If
Next emptyRow
End Sub
However, it would be a good idea to rewrite your code to use a With block, which will make it easier to correctly identify which sheets you are referring to:
Sub inserttexteveryonerow()
Dim Last As Integer
Dim emptyRow As Integer
With Worksheets("Sheet1")
Last = .Range("A" & .Rows.Count).End(xlUp).Row
For emptyRow = Last To 2 Step -1
If Not .Cells(emptyRow, 1).Value = "" Then
.Rows(emptyRow).Resize(1).insert
.Range(.Cells(emptyRow, "A"), .Cells(emptyRow, "F")).Value = Worksheets("Sheet2").Range("A1:F1").Value
End If
Next emptyRow
End With
End Sub
(Correctly qualifying which sheet you are referring to when using Range, Cells, etc, will prevent a lot of errors later.)