Macro replaces non matching criteria - excel

I want to copy/paste formulas in columns where the date is less than today's date.
This goes beyond the criteria and replaces non matching criteria to fit the criteria.
I have a spreadsheet with data from A1:I3. Row 1 contains dates, Rows 2 & 3 contain formulas. The dates in row 1 run from 03/01/22 - 03/09/22.
My macro looks for any dates less than today's date & copies & pastes the formulas as values. This works but the dates in H & I, 03/08/22 and 03/09/22 respectively, are replaced with 03/07/22.
Dim K As String
K = Date
MsgBox K
Dim i As Integer
For i = 1 To 9
If (Cells(1, i).Value < K) Then Cells(1, i).EntireColumn.Copy
Cells(1, i).PasteSpecial xlPasteValues
Next i
End Sub

Your logic only checks when copying, but not when pasting.
Cells(1, i).PasteSpecial xlPasteValues
This is executed for every single i, regardless of whether (Cells(1, i).Value < K) is True or False. You need to use the multi-line If...End If syntax.
If Cells(1, i).Value < K Then
Cells(1, i).EntireColumn.Copy
Cells(1, i).PasteSpecial xlPasteValues
End If
To make this better though, avoid working with a String representation of a date, and bypass the clipboard:
If Cells(1, i).Value < Date Then
Columns(i).Value = Columns(i).Value
End If

Related

How to move cells down its column based off blank cell row in range

I am trying to move cell values in columns K to L down within its column to the same row as every blank cell in column E.
Hopefully this makes sense but I think i need to figure out how to find each blank cell's row number and force it as a row variable i can then use to tell my code to move cell values in range K13:L. For example, if there's a value in K13:L14 and the blank cells in column E is E20 and E23, i want K13 and L13 to move to K20 and L20 while K14 and L14 move to K23 and L23.
The number of blank cells will always match however many cells with value are in column K/L
Would appreciate any help on this!
Use the macro below to start your studies. But first you need to remove the values in column K&L to N&O. (Maybe you can record a macro and add the recorded codes to the start of the codes below.)
Sub move_it()
i = 13
j = 13
Do While Cells(j, 14).Value <> ""
If Cells(i, 5) <> "" Then
i = i + 1
Else
Range("n" & j, "o" & j).Select
Selection.Cut
Range("K" & i).Select
ActiveSheet.Paste
j = j + 1
i = i + 1
End If
Loop
End Sub
The answer that was i needed to offset my copy paste by the rows i needed to move it to!
ws.Range("E" & openitemstartrow + 1, ws.Range("F" & openitemstartrow +
10).End(xlUp)).Copy
targetws.Range("G" & rows.Count, "H" & rows.Count).End(xlUp).Offset(1, 4).PasteSpecial Paste:=xlPasteValues

Concatenate multiple cells in a column into one cell

I need to combine multiple cells in a column in one cell.
Data is present in Column A:
0100
0800
ABCD
LMKQ
.
.
.
and so on
Cell B2 should have the below value:
'0100', '0800', 'ABCD', 'LMKQ'.... and so on
My code identifies all the data but populates just the data in last cell:
Sub concatMyData()
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(2, "B").Value = "'" & Cells(i, "A").Value & " '" & Cells(i + 1, "A").Value & "'"
Next i
End Sub
Check this:
Sub concatMyData()
Dim first As Boolean
first = True
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Not first Then Cells(2, "B").Value = Cells(2, "B").Value & ", "
Cells(2, "B").Value = Cells(2, "B").Value & "'" & Cells(i, "A").Value & "'"
first = False
Next i
End Sub
You can do this with one line of code and not have to loop (much MUCH faster):
Range("B2").Formula = "'" & join(application.transpose(Range("A2:A" & range("A" & rows.count).end(xlup).row)),"', '") & "'"
I assumed you have a header in A1 so started on A2, you can change it to A1 if you wish.
I noticed you asked for an explanation on the other answer so:
Egan's code will loop through each cell in column A and add it to what is currently in cell B2. So it basically adds to B2 the value of what cell it is up in in column A and a ', 'each time it loops until it runs out of data in column A. It also puts a ' on the start and end.
My code will take the range and transpose it into an array (the data goes down, an array goes sideways so we transpose it), then it will join the array of values into a single string. We do this using the JOIN function and we specify ', ' as what it should put between each element of the array (the delimiter).
Then we simply add a ' on the start and the end as it won't have it there to begin with and voila, one string of joined values without looping.
They effectively do the same thing, mine just does it in one go rather than a cell at a time.

pasting in vba data

image worksheetI am setting up sheet with hotels details and column "D" has hospitals that are close by eg PMH,SCGH,FSH. What i am trying to do is search column "D" based on a cell value on same sheet. I have code below but it will only do what i want if the cells in column"D" are single entry eg pmh. I need to be able to search all the cells in Column "D" for any instance of the text.
Many Thanks for any assistance
`Option Explicit
Sub finddata()
Dim hospitalname As String
Dim finalrow As Integer
Dim i As Integer
Sheets("Results").Range("A4:D100").ClearContents
Sheets("Main").Select
hospitalname = Sheets("Main").Range("g3").Value
finalrow = Sheets("Main").Range("A1000").End(xlUp).Row
For i = 2 To finalrow
If Cells(i, 4) = hospitalname Then
Range(Cells(i, 1), Cells(i, 4)).Copy
Sheets("Results").Range("A4").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
End If
Next i
Sheets("Main").Range("g3").Select
End Sub
`
The two simplest ways to do this would be
Using the Like operator:
If Cells(i, 4).Value Like "*" & hospitalname & "*" Then
This method has the drawback that a hospital name of, for instance, PMH might be matched against another one such as SPMH.
Using the InStr function:
If Instr("," & Cells(i, 4).Value & ",", "," & hospitalname & ",") > 0 Then
In this line, I "wrap" both the cell being looked at, and the value being searched for, within commas so it ends up searching for the string (for instance) ",PMH," within the string ",PMH,SCGH,FSH,". InStr will return the character position at which a match occurs, or zero if no match is found. So testing for > 0 is testing whether a match occurred.

Error in Loop when using Month and Year function with integer

I'm having an issue getting my code to work properly. Im trying to compare the month and year in column K to the Month and Year in Cell P2. Then if they are a match, copy and paste a value located Column J (if greater than 0) to Column P. I have pasted my code below. Im not getting any errors, but it is not pasting values either. Any help is appreciated. I also include the code I wrote to get the formulas correct (at bottom). It worked correctly.
Eventually I would like to compare the date in Column K to the dates in Cell P2 - AA2 which each contain a different month of the year (January 2017, February 2017, etc..), but I think If I can get this first loop working, I can figure out the next piece.
Sub Test()
Dim i As Integer
Sheets("Sheet1").Select
For i = 3 To 6
If Month(Range("K" & i)) & Year(Range("K" & i)) = Month(Range("P2")) & Year(Range("P2")) Then
ElseIf Range("J" & i).Value > "0" Then
Range("J" & i).Copy
Range("P" & i).PasteSpecial xlPasteValues
End If
Next i
End Sub
'Original Code I wrote to get the formulas correct before adding the loop and variables
'Sheets("Sheet1").Select
'If Month(Range("K3")) & Year(Range("K3")) = Month(Range("P2")) & Year(Range("P2")) Then
' If Range("J3").Value > "0" Then
' Range("J3").Copy
' Range("P3").PasteSpecial xlPasteValues
' Else
' End If
'Else
'End If
'End Sub

How do I autofilter table contents and count resulting rows?

I am trying to count the instances of an event for both days of the week and hours of the day (to be graphed separately) with VBA. The date/time stamp is in this format: "2/28/2014 20:32"
Example:
AppID = 14329 DateCreated = 2/28/14 20:55 Day = Friday Hour = 20:55
What I have going on right now is copying the data to a new column and setting the date format to "dddd" so it would display as "Sunday" etc. From there I am autofiltering for each day of the week and counting the resulting visible cells. This is working with this code:
With Range("C2:C" & LR)
.AutoFilter
.AutoFilter Field:=3, Criteria1:="Sunday"
cCnt = ActiveSheet.AutoFilter.Range.Columns(3) _
.SpecialCells(xlCellTypeVisible).Cells.Count
For Each cell In Range("C2:C" & cCnt)
Sun = Sun + 1
Next
.AutoFilter Field:=3, Criteria1:="Monday"
cCnt = ActiveSheet.AutoFilter.Range.Columns(3) _
.SpecialCells(xlCellTypeVisible).Cells.Count
For Each cell In Range("C2:C" & cCnt)
Mon = Mon + 1
Next
...etc.
However, my issue is counting the events by hour. I am trying to do it similarly by copying the date/time to a new column and setting the format to "h:mm;#" and autofiltering by hour with this code:
With Range("D2:D" & LR)
.AutoFilter
.AutoFilter Field:=4, Criteria1:="10:??"
cCnt = ActiveSheet.AutoFilter.Range.Columns(4) _
.SpecialCells(xlCellTypeVisible).Cells.Count
For Each cell In Range("D2:D" & cCnt)
time(10) = time(10) + 1
Next
...etc.
This isn't working and I can't figure out why. I've tried changing the criteria1 to various syntax, adding a second criteria parameter and am stumped why this method would work for the first go around but not the second when both columns are derived from the same original data. I have also tried changing the data to a different time format (just "hh" etc).
How Excel stores Dates & Times:
Excel uses a 'serial' number system to store dates (first day is January 1, 1900):
01/01/1900 = 1
01/02/1900 = 2
Time is represented by anything after the decimal (noon is .5 because it's halfway through the day):
01/01/1900 12:00 = 1.5
01/02/1900 15:00 = 2.625
If you filter based on values, it's important to be aware of this.
Include this code in your module:
Public Function GetDay(ByVal inputDate As String) As String
GetDay = WeekdayName(Weekday(inputDate))
End Function
Public Function GetHour(ByVal inputDate As Range) As String
GetHour = Format(inputDate.Value, "Medium Time")
End Function
Now use these functions on your worksheet and AutoFill:
In your existing code modify the following:
With Range("D2")
.AutoFilter Field:=4, Criteria1:="10:?? PM"
'If criteria didn't match anything, cCnt is equal to 1 (because header rows are visible and counted)
cCnt = ActiveSheet.AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Cells.Count
If cCnt > 1 Then
For Each cell In Range("D2:D" & cCnt)
Hour10PM = Hour10PM + 1
Next
End If
MsgBox (Hour10PM & " matches for 10:00PM to 10:59PM")
.AutoFilter Field:=4, Criteria1:="11:?? PM"
cCnt = ActiveSheet.AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Cells.Count
If cCnt > 1 Then
For Each cell In Range("D2:D" & cCnt)
Hour11PM = Hour11PM + 1
Next
End If
MsgBox (Hour11PM & " matches for 11:00PM to 11:59PM")
End With
Additional Notes:
Obviously I just gave a snippet of code, but the idea would be that you could split and keep count of every hour. Then to graph it should be simple.

Resources