I am new to VBA and I will need a help.
I have a worksheet named "Jobs" with raw data table and I want to copy paste certain cells to another worksheet named "Schedule" provided that the source and destination date matches and I use the below. But, I have 3 jobs for the same date and it copy only one. Any help will be appreciated.
Sub CopyBasedonSheet1()
Dim i As Long
Dim j As Long
Worksheets("Schedule").Range("B1:AJ92").ClearContents
Sheet1LastRow = Worksheets("Jobs").Range("G" & Rows.Count).End(xlUp).Row 'G is the Date Column'
Sheet2LastRow = Worksheets("Schedule").Range("A" & Rows.Count).End(xlUp).Row 'A is the Date column'
For j = 1 To Sheet1LastRow
For i = 1 To Sheet2LastRow
If Worksheets("Jobs").Cells(j, 7).Value = Worksheets("Schedule").Cells(i, 1).Value And Worksheets("Jobs").Cells(j, 1).Value = "P" Then
Worksheets("Schedule").Cells(i, 2).Value = Worksheets("Jobs").Cells(j, 3).Value
Worksheets("Schedule").Cells(i, 3).Value = Worksheets("Jobs").Cells(j, 9).Value
Worksheets("Schedule").Cells(i, 4).Value = Worksheets("Jobs").Cells(j, 14).Value
End If
Next i
Next j
End Sub
I need some help with my macros. The idea of this code is that I have one worksheet with big data about clients and multiple sheets which names are salesman's names. I want to copy and paste information about clients based on their salesman. In those salesman worksheet I have two places where I want to paste all clients: from 10th row in each worksheet I want to paste clients according to this condition If ws.Cells(i, "L").Value = salesmanName And ws.Cells(i, "I").Value = "valid". From 39 row in each worksheet I want to paste all clients with this condition ElseIf ws.Cells(i, "L").Value = salesmanName And Not ws.Cells(i, "I").Value = "valid" Then. Now with my code I get all clients of salesman from row 39 in each worksheet, maybe some of you will be able to help me to fix this problem.
Sub ExtractClientsBySalesman()
' Declare variables for the worksheet and last row of data
Dim ws As Worksheet
Dim lastRow As Long
Dim wsMatch As Worksheet
' Set the worksheet variable
Set ws = ThisWorkbook.Sheets("data")
' Find the last row of data in the "data" worksheet
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
' Loop through the data in column "D" (client)
For i = 2 To lastRow
' Check if the value in column "salesman" (column "E") matches "name_surname"
For Each wsMatch In ThisWorkbook.Sheets
Dim pasteRow As Long
Dim pasteRow2 As Long
pasteRow = 10
pasteRow2 = 39
salesmanName = wsMatch.Range("A5").Value
If ws.Cells(i, "L").Value = salesmanName And ws.Cells(i, "I").Value = "valid" Then
' Copy the client information to the new worksheet
pasteRow = wsMatch.Cells(wsMatch.Rows.Count, "A").End(xlUp).Row + 1
' Copy the client information to the worksheet
wsMatch.Cells(pasteRow, 1).Value = ws.Cells(i, 1).Value
wsMatch.Cells(pasteRow, 2).Value = ws.Cells(i, 9).Value
wsMatch.Cells(pasteRow, 3).Value = ws.Cells(i, 42).Value
wsMatch.Cells(pasteRow, 4).Value = ws.Cells(i, 4).Value
wsMatch.Cells(pasteRow, 5).Value = ws.Cells(i, 14).Value
wsMatch.Cells(pasteRow, 6).Value = ws.Cells(i, 16).Value
wsMatch.Cells(pasteRow, 7).Value = ws.Cells(i, 40).Value
wsMatch.Cells(pasteRow, 8).Value = ws.Cells(i, 12).Value
ElseIf ws.Cells(i, "L").Value = salesmanName And Not ws.Cells(i, "I").Value = "valid" Then
pasteRow2 = wsMatch.Cells(wsMatch.Rows.Count, "A").End(xlUp).Row + 1
' Copy the client information to the worksheet
wsMatch.Cells(pasteRow2, 1).Value = ws.Cells(i, 1).Value
wsMatch.Cells(pasteRow2, 2).Value = ws.Cells(i, 9).Value
wsMatch.Cells(pasteRow2, 3).Value = ws.Cells(i, 42).Value
wsMatch.Cells(pasteRow2, 4).Value = ws.Cells(i, 4).Value
wsMatch.Cells(pasteRow2, 5).Value = ws.Cells(i, 14).Value
wsMatch.Cells(pasteRow2, 6).Value = ws.Cells(i, 16).Value
wsMatch.Cells(pasteRow2, 7).Value = ws.Cells(i, 40).Value
wsMatch.Cells(pasteRow2, 8).Value = ws.Cells(i, 12).Value
End If
Next wsMatch
Next i
End Sub
1) It's better deal with next available line with different code. It's easier!
2) Also it's healthier that you exclude data worksheet from salesman worksheets.
3) It is advisable to use the Option Explicit clause to force to declare variables explicitly.
Option Explicit
Sub ExtractClientsBySalesman()
' Declare variables for the worksheet and last row of data
Dim ws As Worksheet
Dim lastRow As Long
Dim wsMatch As Worksheet
Dim valid As Boolean
Dim lPaste As Long
Dim i As Integer
Dim salesmanName As String
' Initial line for each condition
Dim pasteRow As Long
Dim pasteRow2 As Long
pasteRow = 10
pasteRow2 = 39
' Set the worksheet variable
Set ws = ThisWorkbook.Sheets("data")
' Find the last row of data in the "data" worksheet
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
' Loop through the data in column "D" (client)
For i = 2 To lastRow
' column "salesman" (column "E") matches "name_surname"?
For Each wsMatch In ThisWorkbook.Sheets
If wsMatch.Name <> "data" Then
salesmanName = wsMatch.Range("A5").Value
lPaste = 0
If ws.Cells(i, "L").Value = salesmanName Then
valid = ws.Cells(i, "I").Value = "valid"
If valid Then
' 1st section between lines 10 and 37.
' Line 38 is 2nd section header
lPaste = pasteRow2 - 2
' 1st section after line 37 is invalid!
If Not IsEmpty(wsMatch.Cells(lPaste, 1).Value) Then
MsgBox ("Data overflow at first section")
End ' Exit from program
End If
' 1st available line between 10 and 37
lPaste = wsMatch.Cells(lPaste, 1).End(xlUp).Row
lPaste = Application.Max(pasteRow, lPaste + 1)
Else
' 1st available line after line 39
lPaste = wsMatch.Cells(Cells.Rows.Count, 1).End(xlUp).Row
lPaste = Application.Max(pasteRow2, lPaste + 1)
End If
End If ' Same salesman
' Copy the client information to the new worksheet
If (lPaste > 0) Then ' Same Salesman
wsMatch.Cells(lPaste, 1).Value = ws.Cells(i, 1).Value
wsMatch.Cells(lPaste, 2).Value = ws.Cells(i, 9).Value
wsMatch.Cells(lPaste, 3).Value = ws.Cells(i, 42).Value
wsMatch.Cells(lPaste, 4).Value = ws.Cells(i, 4).Value
wsMatch.Cells(lPaste, 5).Value = ws.Cells(i, 14).Value
wsMatch.Cells(lPaste, 6).Value = ws.Cells(i, 16).Value
wsMatch.Cells(lPaste, 7).Value = ws.Cells(i, 40).Value
wsMatch.Cells(lPaste, 8).Value = ws.Cells(i, 12).Value
End If ' Same Salesman
End If ' Other workshets than 'data'
Next wsMatch
Next i
End Sub
Not tested because there is no data example, but my guess is that first time you got ws.Cells(i, "I").Value = "valid" it should go to row 10 and from now on row 11, 12 and so on.
Same for Not ws.Cells(i, "I").Value = "valid": first match should go to 39 and then later to 40, 41 and so on.
If cells A9 and A38 are headers row and they are not empty you could try this:
Replace pasteRow = wsMatch.Cells(wsMatch.Rows.Count, "A").End(xlUp).Row + 1
with pasteRow = wsMatch.Range("A38").End(xlUp).Row + 1
Your code does not work properly because if there is something in A38, when you do pasteRow = wsMatch.Cells(wsMatch.Rows.Count, "A").End(xlUp).Row + 1 it will stop at row 38 and that would explain why you got everything into A39.
It's quite difficult for me because I don't see the data and the expected result in some sheets. Anyway this is not directly the answer to your question, but my guess is something like this :
Table in sheets "DATA" is something like this:
Another sheets (sheet2 to sheet4) is something like this :
Expected result is something like this :
In short, to each sheets other than sheet DATA, get the name value in cell A5, then get range of cells in column L sheet DATA which contains that name. Within this range.offset(0,-3) ---> (column I), to each cell with "Valid" value row Nth, fill the looped sheet (column A to C) start from row 7 with the value of column-1/column-17/column-7 row Nth. And to each cell with value is not "Valid" row Nth, fill the looped sheet (column A to C) start from row 20 with the value of column-1/column-17/column-7 row Nth.
Sub test()
Dim rg As Range: Dim arr: Dim sh
Dim cnt1 As Integer: Dim cnt2 As Integer: Dim i As Integer
Dim rgValid As Range: Dim rgNotValid As Range
With Sheets("DATA") 'change as needed
Set rg = .Range("L2", .Range("L2").End(xlDown)) 'change as needed
End With
arr = Array(1, 14, 7) 'change as needed
For Each sh In Sheets
If Not rg.Find(sh.Range("A5").Value) Is Nothing And sh.Name <> "DATA" Then
With rg
.Replace sh.Range("A5").Value, True, xlWhole, , False, , False, False
With .SpecialCells(xlConstants, xlLogical).Offset(0, -3)
cnt1 = Application.CountA(.Cells): cnt2 = Application.CountIf(.Cells, "Valid")
If cnt1 = cnt2 Then
Set rgValid = .Cells: Set rgNotValid = .End(xlDown)
ElseIf cnt2 = 0 Then
Set rgNotValid = .Cells: Set rgValid = .End(xlDown)
ElseIf cnt1 <> cnt2 And cnt2 <> 0 Then
.Replace "Valid", "", xlWhole, , False, , False, False
Set rgValid = .SpecialCells(xlBlanks): Set rgNotValid = .SpecialCells(xlConstants)
rgValid.Value = "Valid"
End If
End With
.Replace True, sh.Range("A5").Value, xlWhole, , False, , False, False
End With
Set rgValid = rgValid.Offset(0, -8)
Set rgNotValid = rgNotValid.Offset(0, -8)
For i = 1 To UBound(arr) - LBound(arr) + 1
rgValid.Offset(0, arr(i - 1) - 1).Copy Destination:=sh.Cells(7, i) 'change as needed
rgNotValid.Offset(0, arr(i - 1) - 1).Copy Destination:=sh.Cells(20, i) 'change as needed
Next
End If
Next
End Sub
rg is the range of name in sheet DATA column L. There must be no blank cell within this rg.
arr is an array variable with the expected column sequence number. In this example case, the sequence is : column A, column N and column G ---> 1,14,7. In your case, it will be : 1,9,42,4,14,16,40,12.
Then it loop to each sheet other than sheet DATA as sh variable, and get the name which resides in each looped sheet cell A5.
Then in sheet DATA column L, it get the range of cell.offset(0,-3), which value is that name. So, the range is column I (because offset 0,-3). Within this range in column I, it counts how many data are there as cnt1, and count how many data with words "Valid" as cnt2.
If cnt1 = cnt2 then it means in the range of that name, column I all have "Valid" value. So it create a range for all those Valid value as rgValid variable, and create a range which value is blank as rgNotValid variable.
If cnt2 = 0 then it means in the range for that name, column I doesn't have a "Valid" value at all. So it create a range for all those not Valid value as rgNotValid variable, and create a range which value is blank as rgValid variable.
if cnt1 <> cnt2 and cnt2 <> 0 then it means some value within the range for that name has "Valid" value, some not. So it create a range for all those Valid value as rgValid variable, and create a range which value is not "Valid" as rgNotValid variable.
Finally it loop as many as the item in arr to put the expected value to each looped sheet column A to C starting from row 7 for the Valid value, starting from row 20 for the not Valid value.
Please note, the code assumes that in sheet DATA column I and column L, there'll be no blank cell in between row of data.
I am trying to edit my excel table with VBA but an error appears while compiling. It doesnt recognize line 2 and line 10.
Sub IfThenElse()
Dim i As Integer = 23
While Not IsNull(Cells(i, 35).Value)
If Cells(i, 35).Value > 1E+16 Then
Cells(i, 4).Value = Cells(i, 35).Value / 10
Else
Cells(i, 4).Value = Cells(i, 35).Value
i = i + 1
End If
End While
End Sub
You cannot declare a variable and set a value at the same time Dim i As Integer = 23
Row counts are of type Long not Integer, Excel has more rows than Integer can handle.
Dim i As Long
i = 23
While … End While is no valid syntax, you need to use Do While … Loop (see Do...Loop statement).
It is very unlikely that a cell value is Null if you are looking for an empty cell use IsEmpty or check for vbNullString
Do While Not IsEmpty(Cells(i, 35).Value) 'or Do While Not Cells(i, 35).Value = vbNullString
If Cells(i, 35).Value > 1E+16 Then
Cells(i, 4).Value = Cells(i, 35).Value / 10
Else
Cells(i, 4).Value = Cells(i, 35).Value
i = i + 1
End If
Loop
Not sure what exactly you are doing but i = i + 1 might need to come after End If.
Im trying to write a VBA script to compare two = rows and have the spreadsheet highlight the duplicate rows only if certain criteria is met, such as (Value of row, column a = Value of row-1, column) AND Value of row, column b > Value of row-1, column b) Then entirerow of the greater value in column b.font.color = vbRed.
Here is a section of the table I'm running...
Table Selection
Here is the code I am using...
Sub RemoveDuplicates()
Dim i As Long, R As Long
'Dim DeviceName As Range, SerialNumber As Range, LastContact As Range
Application.ScreenUpdating = False
R = Cells(Rows.Count, 1).End(xlUp).Row
'Set DeviceName = Columns(2)
'Set SerialNumber = Columns(3)
'Set LastContact = Columns(7)
For i = R To 2 Step -1
'If Cells(i, "F").Value > Cells(i - 1, "F").Value Then
'Code above doesn't work
If Cells(i, 3).Value = Cells(i - 1, 3).Value And Cells(i, 2).Value = Cells(i - 1, 2).Value Then
'If Cells(i, 3).Value = Cells(i - 1, 3).Value And Cells(i, 2).Value = Cells(i - 1, 2).Value And Cells(i, 5).Value > Cells(i - 1, 5).Value Then
'Code above doesn't work
Cells(i, 1).EntireRow.Font.Color = vbRed
End If
Next i
Application.ScreenUpdating = True
End Sub
I can get the duplicates to highlight, but when I try to introduce the greater than check, the system gets janky.
try a conditional formatting rule.
With worksheets("sheet1").usedrange.offset(1, 0).entirerow
.FormatConditions.Delete
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=and($a2=$a1, $b2=$b1, $f2>$f1)")
.font.Color = vbRed
End With
End With
I am trying to make a VBA scrip that check all cells between B2 and B60 for the text "Ja" that's yes in Norwegian.
How can I make this a little bit simpler that making a "if" command for each cell?
I want it to, if the cell contains "ja"(yes) then write to colum D and the same number.
ie. B1,2,3,4,5 cotains "ja", I need it to take the previous cell value in D1.2,3,4,5 and add another digit to it +1.
If nothing is found in B(ie.false) it needs to write "NEI" in the current cell, and if "NEI" (no) is found in that cell it adds +1 to colum E
Sub Macro2()
Dim celltxt As String
Dim a As Variant
If IsEmpty(Range("B2").Value) = True Then
Cells(2, 2).Value = "NEI"
End If
celltxt = ActiveSheet.Range("B2").Text
If InStr(1, celltxt, "ja") Then
a = Cells(2, 1).Value
'write to cell
Cells(2, 4).Value = Cells(2, 4) + 1
Else
'antall Cw'er vedkommende IKKE har deltatt på
Cells(2, 5).Value = Cells(2, 5) + 1
End If
If IsEmpty(Range("B3").Value) = True Then
Cells(3, 2).Value = "NEI"
End If
celltxt = ActiveSheet.Range("B3").Text
If InStr(1, celltxt, "ja") Then
a = Cells(3, 1).Value
'write to cell
Cells(3, 4).Value = Cells(3, 4) + 1
Else
'antall Cw'er vedkommende IKKE har deltatt på
Cells(3, 5).Value = Cells(3, 5) + 1
End If
End Sub
Sub slettingALL()
Range("D2:E55").Select
Selection.ClearContents
End Sub
Sub slettingdeltakelse()
Range("B2:B60").Select
Selection.ClearContents
End Sub
The following code uses a For Each loop and an IF THEN ELSE statement to check for the value "JA" in the range B2:B60.
If it finds "JA", it looks two columns to the right from the current i location, and adds "+1" to the value above it. If it finds nothing, it writes "NEI" to the current i location, and then moves three columns to the right and adds +1 to the value above it.
Sub Macro2()
For Each i In Range(Cells(2, 2), Cells(60, 2))
If i.Value = "JA" Then
i.Offset(0, 2).Value = i.Offset(-1, 2).Value + 1
Else
i.Value = "NEI"
i.Offset(0, 3).Value = i.Offset(-1, 3).Value + 1
End If
Next i
End Sub
Please let me know if this code does not work for your purpose.