I am trying to set up a function which will be able to check dates from one sheet (sheet1) through 2 columns: startDate and endDate in Sheet2. And if there are matching then I want to copy values from one cell which is located on sheet2 into specific cell (the same row where is the cheking date) into sheet1.
I wrote some code, but later on I've realized that my logic is not good.
I also found this link on stackoverflow website...
my xls file - function is in the module 3 "checkDate"
and here is the code..I need find function somehow..maybe I need to insert two iterators (2 for loops?)
Sub CheckDate()
Dim d1 As Date
Dim d2 As Date
Dim datumPok As Date
Dim s As String
Dim i As Long
Dim LR As Long
LR = Range("K" & Rows.Count).End(xlUp).Row
For i = 2 To LR
d1 = ActiveWorkbook.Worksheets("Glasnik").Cells(i, 2).Value
d2 = ActiveWorkbook.Worksheets("Glasnik").Cells(i, 3).Value
With .Range("K" & i)
datumPok = ActiveWorkbook.Worksheets("Spisak").Cells(i, 11)
If d1 < datumPok < d2 Then
MsgBox "opaaa"
s = ActiveWorkbook.Worksheets("Glasnik").Cells(i, 4).Value
ActiveWorkbook.Worksheets("Spisak").Cells(i, 6).Value = s
Else
MsgBox "test"
End If
End With
Next i
End Sub
I am really into this..thanks guys!
I found the solution!
Ordinary lookup with some mathematic formula was enough.
=LOOKUP(2,1/((G1>=$A$1:$A$24)*(G1<=$B$1:$B$24)),$C$1:$C$24)
assuming that date is in the column G1..
Thanks to all! :)
Related
Good Morning,
I am looking to build a macro to move data between 2 Sheets
In the first sheet, I have data from my manufacture which I called that sheet "original"
In my second Sheet, I called "Finished".
I want to move Data from Original to Finished
In my Original sheet, those headers are not aligned nor are they named the same as in my finished sheet.
in My original sheet, I have a column D which has 3 types of products "Parent, Product Variant, and Standard" so depending on which type of product that data has to be moved into different cells.
So I may need to move original A1 to finished H1 because the match is standard
But if the Match is Parent I may need to move original A1 to C1
or if the match is Product Variation I might need to move A1 to I1
So I am trying to simplify this process
I also may have to merge cells depending on if it is Standard, Parent or Product Variant so I might have data in A1, F1 and AA 1 that have to merged together with a "," or "/" in between
Thanks for any help on pointing me in the right direction for the macro that can help me sort this
Sub Kroll()
Dim i As Long
lastrow lastrow = Sheets("Original").Range("A" & Rows.Count).End(xlUp).row
Sheets("Standard").Range("A2:I999999").ClearContents
For i = 2 To lastrow
If Sheets("original").Cells(i, "D").Value = "Parent Product" Then
Sheets("original").Cells(i, "E").EntireRow.Copy _
Destination:=Sheets("Standard").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End Sub
I've provided some code which may help you moving some data assuming column D is something like in the picture provided. For the merging problem you have to provide some more detailed explanation and example on what you want being merged.
Picture assumed Column D
Option Explicit
Sub Moving_Exact_Data()
'''https://stackoverflow.com/questions/51348750/moving-exact-data'''
Dim originalSheet As Worksheet
Dim finishedSheet As Worksheet
Dim lastRow As Integer
Dim productRange As Range
Dim i As Integer
'Assuming original sheet is Sheet1
Set originalSheet = Sheet1
'Assuming finished sheet is Sheet2
Set finishedSheet = Sheet2
lastRow = originalSheet.Range("D" & Rows.Count).End(xlUp).Row
For i = 1 To lastRow
With originalSheet
If .Cells(i, 4) = "Parent" Then
finishedSheet.Cells(i, 3) = .Cells(i, 4)
ElseIf .Cells(i, 4) = "Product Variant" Then
finishedSheet.Cells(i, 9) = .Cells(i, 4)
ElseIf .Cells(i, 4) = "Standard" Then
finishedSheet.Cells(i, 8) = .Cells(i, 4)
Else
MsgBox ("no match")
End If
End With
Next i
End Sub
I am trying to compare Dates in a vba script. I believe the main issue is my formatting however I am not sure how to solve it.
Sub Rem9()
Dim i As Long
Dim lr As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
wsName = ws.Name
lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
FirstDateRead = CDate("1, 1,2018") 'Initialize the first Day of the year as the last day
For i = 1 To lr
Debug.Print FirstDateRead
Debug.Print ws.Cells(i, 1).Value
If FirstDateRead > ws.Cells(i, 1).Value Then
ws.Cells(i, 3).Value = 121325
End If
Next i
End Sub
According to my output the First Date Read is never greater than the values I am pulling, Which it is for all cases. I have included here an example of the debug.print from the script I am running to show the date formats. Additionally I want to confirm the values I am drawing from are indeed datevaluse as when I run them through the IsDate() Function it returns True.
One other issue if that my date format for the value I call is swapping the year and day. Does anyone know how to solve that. When I use the format function it returns the date as.
Assuming the cells containing the dates are in text format, try wrapping the comparison value in a cDate:
If FirstDateRead > Cdate(ws.Cells(i, 1).Value) Then
ws.Cells(i, 3).Value = 121325
End If
Try using the DateDiff function instead:
Sub dateDifference()
Dim d1 As Date, d2 As Date
d1 = CDate("1, 2,2018")
d2 = Range("A1").Value ' insert a date in A1 to test
Debug.Print DateDiff("d", d1, d2) ' first parameter set to days
End Sub
Edit #1
Use Format to compare apples with apples, so to speak:
d2 = Format(Range("A1").Value, "dd/mm/yyyy")
I need a little bit help with a macro of Excel.
I need to create a macro that automatically find users and copy the values that i have in an other Sheet:
I have one sheet with values that contains the Users and their Kills and Deaths, I create 3 sheets more (3 different groups of users), and I need that the macro copy values automatically finding the users and copying values.
Images to describe it better:
----(Copy this values on)----->
You don't need a macro for this, using the worksheetfunction VLOOKUP is sufficient.
As an example, if you have your headers in row 1 and users in column A, what you'd put into cell B2 (the number of kills for the first user) would be =VLOOKUP($A2;Values!$A$2:$C$9;2;FALSE) and C2 would be =VLOOKUP($A2;Values!$A$2:$C$9;3;FALSE).
The arguments for the function (which you can also find in the linked document) is:
First, the value you're looking for, in your case whatever is in A2
Next the array of values which you want to return a result from - vlookup will only look through the first column, but since you want to return results from the other columns we include columns A:C in the formula.
What column in the range you search to return the result from for kills it is column 2, for deaths column 3.
Finally whether you want to have an exact match (false) or if an approximate one is ok (true).
If I understand what you're after, you should be able to do this with VLOOKUPs
(No VBA necessary)
The following source code solve your problem.
Option Explicit
Dim MyResultWorkbook As Workbook
Dim ValuesWorksheet As Worksheet
Dim SniperWorksheet As Worksheet
Dim ARsWorksheet As Worksheet
Sub CopyResult()
Set MyResultWorkbook = ActiveWorkbook
Set ValuesWorksheet = MyResultWorkbook.Sheets("Values")
Set SniperWorksheet = MyResultWorkbook.Sheets("Sniper")
Set ARsWorksheet = MyResultWorkbook.Sheets("Ars")
Dim SniperLastRow As Long
Dim ARLastRow As Long
Dim RowPointer As Long
Dim ValuePointer As Long
ValuePointer = 2
'Update the Sniper worksheets
SniperLastRow = SniperWorksheet.Cells(SniperWorksheet.Rows.Count, "A").End(xlUp).Row
For RowPointer = 2 To SniperLastRow
Do While (SniperWorksheet.Range("A" & RowPointer).Value <> ValuesWorksheet.Range("A" & ValuePointer).Value)
ValuePointer = ValuePointer + 1
Loop
SniperWorksheet.Range("A" & RowPointer).Offset(0, 1).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 1).Value 'copy kill
SniperWorksheet.Range("A" & RowPointer).Offset(0, 2).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 2).Value 'copy death
ValuePointer = 2
Next
'Update the Ars worksheets
ARLastRow = ARsWorksheet.Cells(ARsWorksheet.Rows.Count, "A").End(xlUp).Row
For RowPointer = 2 To ARLastRow
Do While (ARsWorksheet.Range("A" & RowPointer).Value <> ValuesWorksheet.Range("A" & ValuePointer).Value)
ValuePointer = ValuePointer + 1
Loop
ARsWorksheet.Range("A" & RowPointer).Offset(0, 1).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 1).Value 'copy kill
ARsWorksheet.Range("A" & RowPointer).Offset(0, 2).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 2).Value 'copy death
ValuePointer = 2
Next
End Sub
I have a macro that pulls info from several daily log sheets and compiles that info in a master workbook. In the same macro I manipulate the data so that it populates several charts and graphs. The problem that I have is the info would be most usefull if I could establish a date range that I wanted to look at and only pull that data. For exampl if I want to see the amount of scrap created by all machines from 9/9/14 to 11/9/14. Is there a way I could add this to the begining of my already created macro? The info I'm working with looks something like what I have below.
Machine Operator Date Production Scrap
A w 9/9/14 300 15
B x 9/9/14 400 0
C y 9/12/14 150 50
D z 10/9/14 200 3
This is tested. It will work with a table of changing lengths, and you can adapt the concepts in this to many needs. Have fun.
Sub ScrapCount()
Dim str_dateMin As String
Dim str_dateMax As String
Dim dateMin As Date
Dim dateMax As Date
Dim lastRow As Long
Dim subTotal As Double
Dim lookupDate As Date
Dim lRow As Long
lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
subTotal = 0
str_dateMin = InputBox("Input beginning date, mm/dd/yyyy:")
str_dateMax = InputBox("Input end date, mm/dd/yyyy:")
dateMin = CDate(str_dateMin)
dateMax = CDate(str_dateMax)
For lRow = 2 To lastRow
lookupDate = Sheets("Sheet1").Cells(lRow, "C").Value
If dateMin <= lookupDate And lookupDate <= dateMax Then
subTotal = subTotal + Sheets("Sheet1").Cells(lRow, "E").Value
End If
Next lRow
MsgBox ("Total scrap for date range = " & subTotal)
End Sub
Very broad but here is what I would go with:
Beginning of macro calls a InputBox for date range (1 for start 1
for end) and stores as date variables)
Loop through rows and only
copy if value of date cell is within range of defined variables from
step 1
I do have a workbook where multiple sheets are named based on date (in format MMDDD). This macro should loop trough all date sheet (like 01OCT, 02OCT, .... 30OCT) select range and copy it into new sheet.
Selecting cells, copying them and so is not really problem, and that is working perfectly. However I do have a problem defining sheet name. I would like user in the beginning define month and number of days in month and month using InputBox.
So if user select month = "FEB" and DaysMonth = 28, I would like macro to loop trough sheets named 01FEB, 02FEB, 03FEB, .... 28FEB.
Sub Merge_whole_month()
Application.ScreenUpdating = False
Dim month As String
month = InputBox(Prompt:="Please enter month in format MMM", _
Title:="Month")
Dim DaysMonth As Long
DaysMonth = InputBox(Prompt:="Please enter number of days in month", _
Title:="Days")
'create new sheet for results
Sheets.Add.Name = "Merge"
'loop
For i = 1 To DaysMonth
i = Format(i, "##")
Sheets(i & month).Activate 'here is the problem
'select cell G3, then all "non-empty" cells to the right and down and COPY
Range(Range("G3", Range("G3").End(xlToRight)), Range("G3", Range("G3").End(xlToRight)).End(xlDown)).Select
Selection.Copy
Sheets("Merge").Activate 'activate sheet where cells needs to be copied
'find last cell in 2nd row in sheet
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
lastCol = lastCol + 1
Cells(1, lastCol) = i & month 'log date and month in cell above
Cells(2, lastCol).Select
ActiveSheet.Paste 'Paste
Next i
Application.ScreenUpdating = True
End Sub
Many thanks in advance for any help!
The problem lies in the facto that i = Format(i, "##") does not make i less than 10 appear as 01 etc. To fix this i would do this:
Dim sDate As String
sDate = CStr(i)
If Len(sDate) < 2 Then
sDate = "0" & sDate
End If
Place that code within your for-loop before Sheets(i & month).Activate and remove i = Format(i, "##").
EDIT:
It also seems that for me using Format(i, "0#") gives the string you were looking for. However you will still need to assign this to a String variable or change Sheets(i & month).Activate to Sheets(Format(i, "0#") & month).Activate.
Here is the documentation on the Format() function. I suggest reading it.