When I use ClearContent on a cells which other cells next to it uses formulas, it changes the formulas in those other cells. For example:
.Range("L" & x2 & ":M" & x2).ClearContents
I have formula in N2 which is now =IFERROR(F3/G3*3600,0), I need it to stay =IFERROR(F2/G2*3600,0), the next row N3 now is =IFERROR(#REF!/#REF!*3600,0)
Actual Code:
Dim Sht1 As Worksheet, Sht2 As Worksheet
Dim LstRw As Long, lookup_rng As Range, x
Dim Sht3 As Worksheet, Sht4 As Worksheet
Dim LstRw2 As Long, lookup_rng2 As Range, x2
Set Sht1 = Sheets("Pick Ticket Schedule")
Set Sht2 = Sheets("Pick Ticket (History)")
Set lookup_rng = Sht2.Range("B2:B10")
With Sht1
LstRw = .Cells(.Rows.Count, "T").End(xlUp).Row
For x = LstRw To 2 Step -1
'MsgBox "LstRw:" & LstRw & " " & x & "-" & .Cells(x, 20).Value & " -->" & lookup_rng.Value
If Not lookup_rng.Find(what:=.Cells(x, 20), LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
Sht1.Range("J" & x & ":K" & x).ClearContents 'Shift:=xlUp <-- Only used for delete 'Need to delete value in cell J & K for the row that matches
Sht1.Range("T" & x).ClearContents
End If
Next x
End With
Set Sht3 = Sheets("Master Production Schedule")
Set Sht4 = Sheets("Historical FG")
Set lookup_rng2 = Sht4.Range("B2:B10")
With Sheets("Master Production Schedule")
LstRw2 = .Cells(.Rows.Count, "V").End(xlUp).Row
For x2 = LstRw2 To 2 Step -1
If lookup_rng2.Find(what:=.Cells(x2, 22), LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
.Range("L" & x2 & ":M" & x2).ClearContents 'Need to delete value in cell L & M for the row that matches
.Range("T" & x2).ClearContents
.Range("V" & x2).ClearContents
End If
Next x2
End With
Column O with cells O2 and O3 are also affected in a similar way, I am assuming these 2 are somehow affected by Column L & M. Only Row 2 and Row 3 have data for those columns. What would be the best way to make it so it doesn't affect the following rows? Thanks in advance! -Paul
Related
I would like to compare cells in Worksheet 2 against Worksheet 1.
First check for matching cells in range A for both Worksheets 1 and 2.
Next, if there are no matches, check for matching cells in range B for both Worksheets 1 and 2, otherwise if there are matches, check the next cell in range A.
If there are no matches as well, copy these non-matching cells in ranges A and B in Worksheet 2 to a new worksheet, Worksheet 3.
Here are my worksheets' layout:
Worksheet 1 -
Worksheet 2 -
Worksheet 3 -
Here is my code (which is not working as intended):
Dim Cl As Range, Rng As Range, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
With Dic
For Each Cl In MyWorkSheet1Name.Range("A2:B" & MyWorkSheet1Name.Range("B" & Rows.Count).End(xlUp))
.Item(Cl.Value) = Empty
Next Cl
For Each Cl In MyWorkSheet2Name.Range("A2:B" & MyWorkSheet2Name.Range("B" & Rows.Count).End(xlUp))
If Not .Exists(Cl.Value) Then
If Rng Is Nothing Then Set Rng = Cl Else Set Rng = Union(Rng, Cl)
End If
Next Cl
End With
If Not Rng Is Nothing Then
Rng.EntireRow.Copy MyWorkSheet3Name.Range("A" & Rows.Count).End(xlUp)
End If
How do I get the code to run as intended?
Many thanks!
You could try this:
Dim lRow1 As Long, lRow2 As Long
lRow1 = Sheets(1).Range("A" & Sheets(1).Rows.Count).End(xlUp).Row
lRow2 = Sheets(2).Range("A" & Sheets(2).Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
With Sheets(3)
Sheets(1).Range("A1:B" & lRow1).Copy Destination:=.Range("A1")
Sheets(2).Range("A2:B" & lRow2).Copy Destination:=.Range("A" & lRow1 + 1)
.Range("C2").Formula = "=COUNTIFS($A$2:$A$" & lRow1 + lRow2 - 1 & ",A2,$B$2:$B$" & lRow1 + lRow2 - 1 & ",B2)"
.Range("C2").AutoFill Destination:=.Range("C2:C" & lRow1 + lRow2 - 1)
.Range("A1").AutoFilter Field:=3, Criteria1:=">1"
.Rows("2:" & lRow1 + lRow2 - 1).SpecialCells(xlCellTypeVisible).Delete
.Range("A1").AutoFilter
.Columns(3).EntireColumn.Delete
End With
Application.ScreenUpdating = True
I'm using the below code. My goal is to change this row:
cell.EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
If the number in Sheet1 A2 matches Sheet2 A2
Then copy the data from Sheet1 P2 to Sheet2 P2
(and consecutively if Sheet1 A3 = Sheet2 A3 THEN copy Sheet1 P3 to Sheet2 P3 all the way down the list).
Sub Sheet1Sheet2Compare()
Dim lRow, x As Long
Sheets("Sheet1").Select
lRow = Range("A1").End(xlDown).Row
For Each cell In Range("A2:A" & lRow)
x = 2
Do
If cell.Value = Sheets("Sheet2").Cells(x, "A").Value Then
cell.EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
x = x + 1
Loop Until IsEmpty(Sheets("Sheet2").Cells(x, "A"))
Next
End Sub
try this
Sub Sheet1Sheet2Compare()
Dim lRow As Integer, x As Integer, i As Integer
Dim sht1 As Worksheet, sht2 As Worksheet
Set sht1 = ThisWorkbook.Worksheets("Sheet1")
Set sht2 = ThisWorkbook.Worksheets("Sheet2")
lRow = sht1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lRow
If sht1.Range("A" & i).Value = sht2.Range("A" & i).Value Then sht2.Range("P" & i).Value = sht1.Range("P" & i).Value
Next i
End Sub
I am trying to write a macro that copies a row if a cell in that row contains text (For ex: Mumbai, Delhi etc) from Column C.
For example if there are 30 rows but only 15 contains text(Mumbai & Delhi) in column C. I want to copy those 15 rows and paste them into "Sheet2" I was using the below code. however it is copying all the filled rows. however my requirement is the code should only need to copy columns of a, b, c, d, f, g, h, i, l & m to Sheet2.
Sub testPasteinSh2()
Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range, cel As Range
Dim rngCopy As Range, lastR1 As Long, lastR2 As Long
Dim strSearch1 As String, strSearch2 As String
strSearch1 = "Mumbai" 'or combo value...
strSearch2 = "Delhi" 'or something else...
Set sh1 = ActiveSheet 'use here your worksheet
Set sh2 = Worksheets("Sheet2") 'use here your sheet
lastR1 = sh1.Range("C" & Rows.count).End(xlUp).Row
lastR2 = sh2.Range("A" & Rows.count).End(xlUp).Row + 1
Set rng = sh1.Range("C2:C" & lastR1)
For Each cel In rng.cells
If cel.Value = strSearch1 Or cel.Value = strSearch2 Then
If rngCopy Is Nothing Then
Set rngCopy = sh1.Rows(cel.Row)
Else
Set rngCopy = Union(rngCopy, sh1.Rows(cel.Row))
End If
End If
Next
If Not rngCopy Is Nothing Then
rngCopy.Copy Destination:=sh2.cells(lastR2, 1)
End If
End Sub
Can you please help me. Thank you in Advance.
It looks difficult to ask a clear question...
It happens I know what you need from a previous question. Supposing that you did not change your mind, please test the next code:
Sub testPasteinSh2Bis()
Dim sh1 As Worksheet, sh2 As Worksheet, rng As Range, cel As Range
Dim rngCopy As Range, lastR1 As Long, lastR2 As Long
Dim strSearch1 As String, strSearch2 As String
'a, b, c, d, f, g, h, i, l 'columns to be copied
strSearch1 = "Mumbai" 'or combo value...
strSearch2 = "Delhi" 'or something else...
Set sh1 = ActiveSheet 'use here your worksheet
Set sh2 = sh1.Next 'use here your sheet
lastR1 = sh1.Range("C" & Rows.count).End(xlUp).Row
lastR2 = sh2.Range("A" & Rows.count).End(xlUp).Row + 1
Set rng = sh1.Range("C2:C" & lastR1)
For Each cel In rng.cells
If cel.Value = strSearch1 Or cel.Value = strSearch2 Then
If rngCopy Is Nothing Then
Set rngCopy = sh1.Range(sh1.Range("A" & cel.Row & ":D" & cel.Row).Address & "," & _
sh1.Range("F" & cel.Row & ":I" & cel.Row).Address & "," & sh1.Range("L" & cel.Row).Address)
Else
Set rngCopy = Union(rngCopy, sh1.Range(sh1.Range("A" & cel.Row & ":D" & cel.Row).Address & "," & _
sh1.Range("F" & cel.Row & ":I" & cel.Row).Address & "," & sh1.Range("L" & cel.Row).Address))
End If
End If
Next
If Not rngCopy Is Nothing Then
rngCopy.Copy Destination:=sh2.cells(lastR2, 1)
End If
End Sub
It should copy the columns a, b, c, d, f, g, h, i, l for the matching cases...
You could try this:
Sub Macro1()
Dim lastrow As Long, erow As Long
Dim rng1 As Range
Dim rng2 As Range
'choose an empty column, in my example is O.
With Worksheets("Sheet1")
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("O2:O" & lastrow).FormulaR1C1 = "=IF(OR(RC[-12]=""Mumbai"",RC[-12]=""Delhi""),1,"""")" 'here is -12 because difference between column C and O is 3. Change it according your needs
Set rng1 = .Range("O2:O" & lastrow).SpecialCells(xlCellTypeFormulas, 1)
For Each rng2 In rng1.Cells
erow = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet2").Range("A" & erow + 1 & ":M" & erow + 1) = .Range("A" & rng2.Row & ":M" & rng2.Row).Value 'this will copy the full row of data from A to M
Next rng2
Set rng1 = Nothing
.Range("O2:O" & lastrow).Clear
End With
'delete the columns copied but you don't want like E, J,K
With Worksheets("Sheet2")
.Columns("E:E").Delete
.Columns("J:K").Delete
End With
End Sub
This code will copy the row of data and delete the columns you don't want.
In case that's not posible, then you can copy single ranges. You could replace line
Worksheets("Sheet2").Range("A" & erow + 1 & ":M" & erow + 1) = .Range("A" & rng2.Row & ":M" & rng2.Row).Value 'this will copy the full row of data from A to M
with
Worksheets("Sheet2").Range("A" & erow + 1).Value = .Range("A" & rng2.Row).Value 'a single cell
Probably you can adapt this to your needs.
I need to write a code to perform the vlookup in H column in workbook 1, the match is from column A in a separate workbook and the result is column B for the other workbook.
No idea how to go about this
could someone please help
Sub y()
Dim rw As Long, x As Range, v As Variant
Dim extwbk As Workbook, twb As Workbook
Dim wsActiveSheet As Worksheet
Columns("H").Insert
Range("H1") = "1st phase"
Set wsActiveSheet = Application.ActiveSheet
Set extwbk = Workbooks.Open("C:\Users\OUROBOROS\Desktop\Goldratt\24-6-19\1st phase stores.xlsx") 'file with reference table
Set x = extwbk.Worksheets("Sheet1").Range("A2:A300")
For rw = 2 To wsActiveSheet.Cells(Rows.Count, "G").End(xlUp).Row
v = Application.Match(wsActiveSheet.Cells(rw, "G").Value, x, 0)
If IsNumeric(v) Then
wsActiveSheet.Cells(rw, "H").Value = extwbk.Worksheets("Sheet1").Cells(rw, "b").Value 'G is in the table
Else
wsActiveSheet.Cells(rw, "H").Value = "NA" ''G is NOT in the table
End If
Next rw
Dim LR As Long
Range("a1").EntireRow.Insert
LR = Range("v" & Rows.Count).End(xlUp).Row
Range("v1").Formula = "=SUBTOTAL(9,v3:v" & LR & ")"
LR = Range("v" & Rows.Count).End(xlUp).Row
Range("w1").Formula = "=SUBTOTAL(9,w3:w" & LR & ")"
LR = Range("v" & Rows.Count).End(xlUp).Row
Range("x1").Formula = "=SUBTOTAL(9,x3:x" & LR & ")"
LR = Range("v" & Rows.Count).End(xlUp).Row
Range("y1").Formula = "=SUBTOTAL(9,y3:y" & LR & ")"
End Sub
I'm not sure if this will be what you actually need because you were saying some columns on your question and there are totally different ones on your code. You can change the columns by chaning the numbers refering to them arr(i, X) the X is the column number.
Option Explicit
Sub y()
Dim arrSource, arrLookUp
Dim DictData As New Scripting.Dictionary 'Needs the Microsoft Scripting Runtime 'Tools->References
Dim i As Long
Dim extwbk As Workbook
With ThisWorkbook.Sheets("MySheet") 'Change MySheet for your sheet name(the one were you are doing the vlookup)
.Columns("H").Insert
.Range("H1") = "1st phase"
arrSource = .UsedRange.Value 'store the whole sheet inside the array
End With
Set extwbk = Workbooks.Open("C:\Users\OUROBOROS\Desktop\Goldratt\24-6-19\1st phase stores.xlsx") 'file with reference table
With extwbk.Sheets("MyOtherSheet") 'Change MyItherSheet for the name of the sheet holding the reference table
arrLookUp = .UsedRange.Value 'store the whole sheet inside the array
End With
extwbk.Close SaveChanges:=False 'close the file with the reference table (the data is already in the array)
'Create a dictionary holding the index for the lookup
For i = 2 To UBound(arrLookUp) 'loop through the reference table
If Not DictData.Exists(arrLookUp(i, 1)) Then 'check if the value in column A is not duplicated
DictData.Add arrLookUp(i, 1), arrLookUp(i, 2) 'add the matching value from column A with it's value in column B
End If
Next i
'Loop through your original table to find the matches
For i = 2 To UBound(arrSource)
If Not DictData.Exists(arrSource(i, 7)) Then 'check if we have a match inside the dictionary for column G
arrSource(i, 8) = "NA" 'if column G value is not found in the dictionary, column H will have a "NA"
Else
arrSource(i, 8) = DictData(arrSource(i, 7)) 'if column G value is found in the dictionary, column H will have column B from the other workbook
End If
Next i
Dim LR As Long
With ThisWorkbook.Sheets("MySheet") 'Change MySheet for your sheet name(the one were you are doing the vlookup)
.UsedRange.Value = arrSource 'drop back the array into the sheet
.Range("a1").EntireRow.Insert
LR = Range("v" & .Rows.Count).End(xlUp).Row
.Range("v1").Formula = "=SUBTOTAL(9,v3:v" & LR & ")"
LR = .Range("v" & .Rows.Count).End(xlUp).Row
.Range("w1").Formula = "=SUBTOTAL(9,w3:w" & LR & ")"
LR = .Range("v" & .Rows.Count).End(xlUp).Row
.Range("x1").Formula = "=SUBTOTAL(9,x3:x" & LR & ")"
LR = .Range("v" & .Rows.Count).End(xlUp).Row
.Range("y1").Formula = "=SUBTOTAL(9,y3:y" & LR & ")"
End With
End Sub
I am trying to retrieve data from another file using the VLOOKUP function however this is only to happen depending on if any of the 2 items of data appear in column 3(C)
"PO Materials" OR
"PO Labor"
Sub MakeFormulas()
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Dim X As Long
'What are the names of our worksheets?
Set sourceSheet = Worksheets("Sheet1")
Set outputSheet = Worksheets("Sheet2")
'Determine last row of source
With sourceSheet
SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With outputSheet
'Determine last row in col C
OutputLastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
For X = 5 To OutputLastRow
If InStr(1, .Range("C" & X), "PO Materials") > 0 Then
'Apply our formula
.Range("Q2:Q" & OutputLastRow).Formula = _
"=VLOOKUP(E2,'" & sourceSheet.Name & "'!$A$2:$B$" & SourceLastRow & ",2,0)"
End If
Next
End With
End Sub
Code is working; However, its giving #N/A if the cell is blank or contains any value in Column C, which means its not recognizing the If statement. If the column does not containn "PO Materials" or "PO Labor" I would like it to skip to the next cell in the range
Thanks in advance for any help given.
The code that generates the VLOOKUP is applying that formula to each cell in the column every time. That is, every time your If condition finds "PO Materials", it will apply the VLOOUKP to every cell between Q2 and the last row from column E.
I think this is what you want:
.Range("Q" & X).Formula = _
"=VLOOKUP(E" & X & ",'" & sourceSheet.Name & "'!$A$2:$B$" & SourceLastRow & ",2,0)"
Alternatively, it could be done completely within the spreadsheet:
=IF(ISERROR(FIND("PO Materials",C6)),"",VLOOKUP(E6,Sheet1!$A$2:$B$6,2,0))
Final Code for future reference
Sub MakeFormulas()
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Dim X As Long
'What are the names of our worksheets?
Set sourceSheet = Worksheets("Sheet1")
Set outputSheet = Worksheets("Sheet2")
'Determine last row of source
With sourceSheet
SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With outputSheet
'Determine last row in col C
OutputLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For X = 2 To OutputLastRow
If InStr(1, .Range("C" & X), "PO Materials") + InStr(1, .Range("C" & X), "PO Labor") > 0 Then
'Apply our formula
.Range("Q" & X).Formula = _
"=VLOOKUP(E" & X & ",'" & sourceSheet.Name & "'!$A$2:$B$" & SourceLastRow & ",2,0)"
End If
Next
End With
End Sub