VBA Macro

matrix26

Board Regular
Joined
Dec 16, 2020
Messages
57
Office Version
  1. 365
Platform
  1. Windows
Hail to thee Gods of Excel,

I have wrestled with this for a few weeks now and I'm getting no where, FAST.
I've even wasted my time trying ChatGPT.

I have a worksheet called "DEVICE INFO"

Column Z of that worksheet has a time range in it, 20:00 - 06:00 etc.

The time range can vary from cell to cell in the column, but it will always be a 10 hour time range and always on the hour.
There will also be hidden rows that I need to ignore
I'm trying to come up with a way to automatically search down column Z, finding all matching time ranges and giving them a batch number
That batch number should be automatically entered in to column B
I.E
The code should find all cell entries that show 00:00 - 10:00 and place a 1 in the appropriate cell in column B
the code should then move on to find all cell entries that show 01:00 - 11:00 and place a 2 in the appropriate cell in column B
The code should iterate until it has gone from 00:00 - 10:00 right through to 23.00 - 09.00
Now, to make matters more complex if the code finds more than 100 entries for any iteration it should start a new "batch" number and continue until no more entries for that particular range are found

All info from column C through Y are irrelevant

I hope what I ask is possible and I thank you all in advance

p.s
here are the ranges so you don't have to write them

00:00 - 10:00
01:00 - 11:00
02:00 - 12:00
03:00 - 13:00
04:00 - 14:00
05:00 - 15:00
06:00 - 16:00
07:00 - 17:00
08:00 - 18:00
09:00 - 19:00
10:00 - 20:00
11:00 - 21:00
12:00 - 22:00
13:00 - 23:00
14:00 - 00:00
15:00 - 01:00
16:00 - 02:00
17:00 - 03:00
18:00 - 04:00
19:00 - 05:00
20:00 - 06:00
21:00 - 07:00
22:00 - 08:00
23:00 - 09:00
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Hi Matrix,

why don't you use just the sort function of XL?

asks the Senior
 
Upvote 0
Hi
If more than 100 in a batch what should the new batch number be?
2 or 24+n?
 
Upvote 0
Hi Matrix,

why don't you use just the sort function of XL?

asks the Senior
There are, at present, 4500 entries in the worksheet.
10 different criteria plus the 24 time ranges.
Filtering is possible, but not practical.
 
Upvote 0
Hi
If more than 100 in a batch what should the new batch number be?
2 or 24+n?
If there are more than 100 entries the next batch number should be the next sequential number.
So if the interation is 1 then, yeah, the next batch number should be 2 etc.

Thanks
 
Upvote 0
I've got it!

VBA Code:
Sub BatchDuplicateDeviceInfo()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("DEVICE INFO")
   
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.count, "Y").End(xlUp).Row
   
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
   
    Dim i As Long
    Dim batchCounter As Long
    batchCounter = 1 ' Initialize the batchCounter
   
    Dim matchCounter As Long ' Counter to track matches for each key
   
    ' Loop through the data in column Y and batch duplicates
    For i = 2 To lastRow ' Assuming row 1 is the header
        If Not ws.Rows(i).Hidden Then ' Ignore hidden rows
            If CStr(ws.Cells(i, "Y").value) <> "" Then ' Only process non-empty cells in column Y
                Dim keyValue As String
                keyValue = CStr(ws.Cells(i, "Y").value)
                If Not dict.Exists(keyValue) Then
                    dict.Add keyValue, batchCounter
                    ws.Cells(i, "B").value = batchCounter
                    matchCounter = 1 ' Reset the matchCounter for a new key
                    batchCounter = batchCounter + 1 ' Increment batchCounter for the next batch
                Else
                    If matchCounter <= 100 Then
                        ws.Cells(i, "B").value = dict(keyValue)
                        matchCounter = matchCounter + 1 ' Increment the matchCounter for this key
                    Else
                        dict(keyValue) = batchCounter ' Set the batch number for this key
                        ws.Cells(i, "B").value = batchCounter
                        batchCounter = batchCounter + 1 ' Increment batchCounter for the next batch
                        matchCounter = 1 ' Reset the matchCounter for a new key
                    End If
                End If
            End If
        End If
    Next i
End Sub
 
Last edited by a moderator:
Upvote 0
Solution
Good to hear you got the solution & thanks for posting it to help future readers.
However, when posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time. 😊
 
Upvote 0

Forum statistics

Threads
1,222,441
Messages
6,166,052
Members
452,010
Latest member
triangle3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top