I'm trying to develop a simply copy+paste values where the macro will take a date that populates into a cell, searches for the date in the next sheet, and pastes the values from A2:X2 where it finds the date.
Sub Copy_PasteVal()
Dim dDate As Range
Dim shtTrack As Worksheet
Dim shtData As Worksheet
Dim c As Range
Dim DestCell As Range
Set shtdata = Sheets(“Daily Total”)
Set shtTrack = Sheets("Overall Daily Tracking")
Set dDate = shtData.Range(“A2”)
Worksheets("shtData").Range("A2:X2").Copy
With Worksheets(shtTrack).Range("a1:a1000")
Set DestCell = .Find(dDate, LookIn:=xlValues)
End With
Worksheets(“shtTrack”).Range(DestCell).PasteSpecial Paste:=xlPasteValues
End Sub
It's not compiling and I'm hoping some gurus out there can help me figure out coding in VBA!
Edit: I may have it backwards? Also, not sure if you intended to wipe out column A...
Dim dDate
Dim shtTrack As Worksheet
Dim shtData As Worksheet
Dim c As Range
Dim DestCell As Range
Set shtData = Sheets("Daily Total")
Set shtTrack = Sheets("Overall Daily Tracking")
dDate = shtData.Range("A2").Value
Set c = shtData.Range("A2:X2")
With shtTrack.Range("a1:a1000")
Set DestCell = .Find(dDate, LookIn:=xlValues)
If Not DestCell Is Nothing Then
r = DestCell.Row
Else
Exit Sub
End If
End With
With shtTrack
.Range(.Cells(r, 1), .Cells(r, 24)).Value = c.Value
End With
Related
I'm trying to dynamically define a range in row like ctrl+down or ctrl+shift+down (to next blank cell) to be used with "For Each itm In rng" statement.
Originally I had it static like this set rng = Range("A4:A10")
So I tried to change it to something like this
Dim rng As Range
Set rng = Range("A4").CurrentRegion.Rows.Count
For Each itm In rng
...
Next itm
I also tried something like this
Set StartCell = Range("A4")
rng = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
But the code doesn't seems to work with "For Each itm In rng" statement
Any help is very much appreciated.
You can use .xlDown, it's the equivalent of pressing ctrl+Shift+down.
Dim rng As Range
Dim lastRow As Long
lastRow = Range("A4").End(xlDown).Row
Set rng = Range("A4:A" & lastRow)
For Each itm In rng
'do something
Next itm
Try this if it helps:
Option Explicit
Sub Test()
Dim LastRow As Long 'to find the last row on your range
Dim MyRange As Range 'to reference the whole range
Dim C As Range 'to loop through your range
With ThisWorkbook.Sheets("MySheet") 'change MySheet for your sheet name
LastRow = .Cells(4, 1).End(xlDown).Row 'last row, how? You go down to the last row and then ctrl + up
Set MyRange = .Range("A4:A" & LastRow) 'dynamic range
For Each C In MyRange
'your code
Next C
End With
End Sub
I'm trying to compare two columns in two different WB let's say A and B which have only column each.
I'd like to msgbox a text whenever the value of cell in the column of A is also in the column of B.
I managed to put values in a variant variable and like now to compare them. I still get a 424 error at the final if statement that checks the correspondance.
Here is the code :
Option Explicit
Sub uniformisation()
Dim range1 As Variant
Dim range2 As Variant
Dim Tab1 As Variant, tab2 As Variant
Dim fichierM As Workbook
Dim fichierF As Workbook
Set fichierF = Workbooks.Open("thepath")
Set fichierMission = Workbooks.Open("thepath")
fichierF.Activate
fichierM.Activate
Dim wsF As Worksheet
Dim wsM As Worksheet
Set wsF = fichierF.Worksheets("test")
Set wsM = fichierM.Worksheets("A")
Dim C As range
Dim D As range
Set C = wsFlex.Columns(1)
Set D = wsMiss.Columns(1)
Dim TotalRows1 As Long
Dim TotalRows2 As Long
With wsF
TotalRows1 = C.Rows(Rows.Count).End(xlUp).Row
Tab1 = range(Cells(2, 1), Cells(TotalRows1, 1)).Value
MsgBox UBound(Tab1)
End With
With wsM
TotalRows2 = Rows(D.Rows.Count).End(xlUp).Row
tab2 = range(Cells(2, 2=1), Cells(TotalRows2, 1))
MsgBox UBound(tab2)
End With
For Each range1 In Tab1
For Each range2 In tab2
If range1.Value = range2.Value Then
MsgBox range1
End If
Next range2
Next range1
fichierM.Close
fichierF.Close
End Sub
Any help would be really apreciated, thanks !
you definitions are all over the place and the code is too long for what it is supposed to do. Also, you have chosen variant which is not really needed for what you want to do. Here is a shorter version that can get you started:
Sub CompareTwoColumns()
Dim rng1 As Range
Dim rng2 As Range
Dim WB1 As Workbook
Dim WB2 As Workbook
'make sure both workbooks are open
Set WB1 = Workbooks.Open("thepath1")
Set WB2 = Workbooks.Open("thepath2")
'loop through both columns and compare
For Each rng1 In WB1.Worksheets("Sheet1").UsedRange.Columns(1).Cells
For Each rng2 In WB2.Worksheets("Sheet1").UsedRange.Columns(1).Cells
If rng1.Value = rng2.Value Then
MsgBox rng1.Value
End If
Next rng2
Next rng1
End Sub
I have a simple range of cells in Sheet1. I wanted to copy this entire range of cells and paste it in the next position just bypass one column. Then I wanted to automatic change the date to the next date.
Please see snip image.
Code so far:
Sub Copy()
Range("A1:D5").Copy Range("F1:I5")
Range("I3:I5").ClearContents
End Sub
Give this a try:
Sub tgr()
Dim ws As Worksheet
Dim rCopy As Range
Dim rDest As Range
Dim dtLastDate As Date
Set ws = ActiveWorkbook.ActiveSheet
Set rCopy = ws.Range("A1").CurrentRegion
Set rDest = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Offset(, 2)
dtLastDate = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Value2
rCopy.Copy rDest
ws.Cells(3, rDest.Column + rCopy.Columns.Count - 1).Resize(rCopy.Rows.Count - 2).ClearContents
rDest.Cells(1, 1).Value = dtLastDate + 1
End Sub
I have two separate Excel files. In one of these in Sheet1 is stored infomration about orders and order numbers. Now every time I make a new order I want this information be collected from my order and inserted in to so called "database" workbook. It should identify the last empty row in column A:A in C:\Users\user\Desktop\Order_number.xlsx and insert new values from range ("C6,C17,C10,H18,B32,G32,H6,H9") to the next empty row. Here is the code I came up to but there is some mistake and it is not working. How it can be fixed?
Sub TransferValues465()
Dim wsMain As Worksheet: Set wsMain = ThisWorkbook.ActiveSheet
Dim wsData As Worksheet: Set wsData = Workbooks.Open("C:\Users\user\Desktop\Order_number.xlsx").Sheets("Sheet1")
Dim rngToCopy As Range: Set rngToCopy = wsMain.Range("C6,C17,C10,H18,B32,G32,H6,H9")
Dim c As Long
Dim ar As Range
Dim cl As Range
Dim LastRow As Long
Dim rngDestination As Range
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With
'Get the last row in Database sheet:
LastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
Set rngDestination = wsData.Cells(LastRow + 1, 1).Resize(1, 25).Offset(0, 0)
For Each ar In rngToCopy.Areas
For Each cl In ar
c = c + 1
'I used this next line for testing:
' rngDestination.Cells(c).Value = cl.Address
rngDestination.Cells(c).Value = cl.Value
Next
Next
End Sub
A few corrections:
1) Set wsData = Workbooks("C:\Users\user\Desktop\Order_number.xlsx").Sheets("Sheet1") will not work. Either use Set wsData = Workbooks("Order_number.xlsx").Sheets("Sheet1") if the workbook is open. Or you need to open the workbook first.
2) I am not famliar on using Application.WorksheetFunction.CountA(wsData.Range("A:A")) to get the last row. To get the last row in Column A (with the possibility of skipping balnk cells in the middle) use wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row.
3) My preference is to use Copy >> PasteSpecial xlPasteValues with cl.Copy and the following line wsData.Range("A" & C).PasteSpecial xlPasteValues.
Code
Option Explicit
Sub TransferValues465()
Dim wsMain As Worksheet
Dim wbData As Workbook
Dim wsData As Worksheet
Dim rngToCopy As Range
Dim C As Long
Dim ar As Range
Dim cl As Range
Dim LastRow As Long
Dim rngDestination As Range
Set wsMain = ThisWorkbook.ActiveSheet
Application.DisplayAlerts = False
' you need to open the workbook
Set wbData = Workbooks.Open("C:\Users\user\Desktop\Order_number.xlsx")
Set wsData = wbData.Sheets("Sheet1")
Set rngToCopy = wsMain.Range("C6,C17,C10,H18,B32,G32,H6,H9")
'Get the last row in Database sheet:
LastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
C = 1
For Each cl In rngToCopy
cl.Copy
wsData.Cells(LastRow + 1, C).PasteSpecial xlPasteValues
C = C + 1
Next cl
wbData.Close True '<-- close and save the changes made
Application.DisplayAlerts = True '<-- restore settings
End Sub
Sub FillEmptyCell()
Dim rng As Range
Dim i As Long
Dim cell As Range
Dim sht As Worksheet
Set sht = ActiveWorkbook.Sheets("Sheet1")
sht.Activate
Set rng = Range(Range("C12"), Range("AD" & sht.UsedRange.Rows.Count))
For Each cell In rng
If cell.Value = "" Then
cell.Value = "0"
End If
Next
End Sub
I am trying to fill my blank spaces in sheet with zero dynamically.However,
I don't want this to fill zeroes in row that have no data. can someone help please?
See how this works,
Sub ZeroStuff()
Dim LstRw As Long, rng As Range, sh As Worksheet, c As Range
Set sh = Sheets("Sheet1")
With sh
LstRw = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
Set rng = .Range("C12:C" & LstRw).SpecialCells(xlCellTypeBlanks)
For Each c In rng.Cells
.Range(c.Offset(, 1), c.Offset(, 27)) = 0
Next c
End With
End Sub