Categorizing group of numbers which depicts an area coverage on a grid map

Chlwls808 · Aug 22, 2021

Hi,

I think this is more of a VBA question than a function.

Imagine a grid system that is numbered based on rows and columns. The numbers are rows, and letters are column - sort of like an excel sheet except rows increase from bottom to top.

4A 4B 4C 4D
3A 3B 3C 3D
2A 2B 2C 2D
1A 1B 1C 1D

Now, imagine again that each grid has 9 boxes numbered from top to bottom - 3 numbers per row (something like your telephone keypad).

The following list are coordinates which covers the grid. The numbers following the letter represent the area of each grid it covers (keypad format).

4A89
4B789
4C78
3A2356
3B123456
3C1245
2C9
2D78
1C3
1D12

If the list were randomized, is there a programmatical way to distinguish the list and categorize them by their areas? Whether if it's in two separate columns or text, doesn't matter; As long as they are separated.

Peter_SSs · Sep 7, 2021

What do you make of this then.

First, I have assumed ...
- Okay to include a blank row 1 and a blank column A. This simplifies the mapping groups process. I assume in the end these may be hidden.
- Items listed in column CC, starting at row 2 (row 1 probably hidden as mentioned above)
- Results to co in columns CE, CF, etc

Given your comments about 2 groups for the sample in post #19, I gather that a column CC item may appear in more than one group - see yellow items highlighted below. Or else perhaps my column CC sample data is not possible?

Anyway, this is what I came up with.
If your column CC list might be long, then it may be possible that code seems a bit slow. If that happens, post back as there may be another way.

VBA Code:

Sub FillAndMapLarge()
  Dim d As Object, dGr As Object
  Dim itms As Variant
  Dim r As Range, c As Range
  Dim i As Long, Grp As Long
  Dim adr As String, pref As String
  
  'Fill
  Application.ScreenUpdating = False
  Range("B2:CA28").ClearContents
  For Each r In Range("CC2", Range("CC" & Rows.Count).End(xlUp))
    With Cells(29 - 3 * Left(r.Value, 1), 3 * (Asc(Mid(r.Value, 3, 1)) - 64) - 1).Resize(3, 3)
      For i = 4 To Len(r.Value)
        .Cells(Mid(r.Value, i, 1)) = Mid(r.Value, i, 1)
      Next i
    End With
  Next r
  
  'Map
  Set d = CreateObject("Scripting.Dictionary")
  Set dGr = CreateObject("Scripting.Dictionary")

  For Each c In Range("B2:CA28").SpecialCells(xlConstants)
    adr = c.Address(0, 0)
    pref = (9 - Int((c.Row - 2) / 3)) & "A" & Chr(Int((c.Column - 2) / 3) + 65) & "*"
    Select Case True
      Case Not IsEmpty(c.Offset(-1).Value) And d.exists(c.Offset(-1).Address(0, 0))
        'Cell above is already in a group
        d(adr) = d(c.Offset(-1).Address(0, 0))
      Case Not IsEmpty(c.Offset(, 1).Value) And d.exists(c.Offset(, 1).Address(0, 0))
        'Cell at right is already in a group
        d(adr) = d(c.Offset(, 1).Address(0, 0))
      Case Not IsEmpty(c.Offset(1).Value) And d.exists(c.Offset(1).Address(0, 0))
        'Cell below is already in a group
        d(adr) = d(c.Offset(1).Address(0, 0))
      Case Not IsEmpty(c.Offset(, -1).Value) And d.exists(c.Offset(, -1).Address(0, 0))
        'Cell at left is already in a group
        d(adr) = d(c.Offset(, -1).Address(0, 0))
      Case Else
        'No adjoining cells in a group so start a new group
        Grp = Grp + 1
        d(adr) = "Group " & Grp
    End Select
    
    'Check column CC values & allocate to group
    For Each r In Range("CC1", Range("CC" & Rows.Count).End(xlUp))
      If r.Value Like pref & c.Value & "*" Then
        dGr(d(adr)) = dGr(d(adr)) & " " & r.Value
        Exit For
      End If
    Next r
  Next c
  
  'Enter results in columns CE onwards
  Range("CE2").CurrentRegion.ClearContents
  For Grp = 1 To dGr.Count
    Range("CD2").Offset(, Grp).Value = dGr.Keys()(Grp - 1)
    itms = Split(Mid(dGr.Items()(Grp - 1), 2))
    With Range("CD2").Offset(1, Grp).Resize(UBound(itms) + 1)
      .Value = Application.Transpose(itms)
      .Resize(.Rows.Count + 1).RemoveDuplicates Columns:=1, Header:=xlNo
    End With
  Next Grp
  Application.ScreenUpdating = True
End Sub

My sample data and results. I've hidden a lot of empty columns to keep this a bit smaller.

Chlwls808_1.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

AC

AD

AE

AF

AG

AH

AI

AJ

AK

BV

BW

BX

BY

BZ

CA

CB

CC

CD

CE

CF

CG

CH

CI

CJ

1

2

4AC78

Group 1

Group 2

Group 3

Group 4

Group 5

Group 6

3

9AK789

7AB5689

6AC15

6AC249

4AC78

3AZ89

4

7

8

9

2AZ1234

8AK23

6AC249

2AZ1234

5

2

3

1

2

3

8AK23

8AL12345

6

4

5

8AL12345

7

7AB5689

8

6AC15

9

5

6

6AC249

10

8

9

3AZ89

11

1

2

12

4

5

13

9

14

15

16

17

18

19

7

8

20

21

22

8

9

23

1

2

3

24

4

25

26

27

28

29

Large

Chlwls808 · Sep 8, 2021

@Peter_SSs Thanks for doing this! I've applied your code and tried to run it. But it gives me a compile error. Any idea what I'm doing wrong?

As you can see I've set it up exactly as yours.

On a separate note, say I want to cater to numbers that's not between 1-9 but instead 20-8, or 31-9.. given the need at the time.. is there a quick adjustments I can make in the function?

Thanks

Chlwls808 · Sep 8, 2021

Chlwls808 said:
@Peter_SSs Thanks for doing this! I've applied your code and tried to run it. But it gives me a compile error. Any idea what I'm doing wrong?

View attachment 46520

As you can see I've set it up exactly as yours.

View attachment 46521

On a separate note, say I want to cater to numbers that's not between 1-9 but instead 20-8, or 31-9.. given the need at the time.. is there a quick adjustments I can make in the function?

Thanks

Disregard above comment! I mistakenly didn't paste the full code.

Given your comments about 2 groups for the sample in post #19, I gather that a column CC item may appear in more than one group - see yellow items highlighted below. Or else perhaps my column CC sample data is not possible?

Yeah, the type of sample data is unlikely to happen.

If your column CC list might be long, then it may be possible that code seems a bit slow. If that happens, post back as there may be another way.

No worries, I won't have that many to group on each mapping

If you know of what I can do about my below comment that would be great!

On a separate note, say I want to cater to numbers that's not between 1-9 but instead 20-8, or 31-9.. given the need at the time.. is there a quick adjustments I can make in the function?

Chlwls808 · Sep 8, 2021

@Peter_SSs I've been playing around with some data and came across several instances of "Run-time error '1004': To do this, all the merged cells need to be the same size." Then it populates multiple duplicate copies of the same data in one of the group and I don't understand why.

One of the sample data were the following:

5AH4569

5AI45789

3AK369

3AL12345678

3AM12345689

2AM123456

Peter_SSs · Sep 9, 2021

Chlwls808 said:
say I want to cater to numbers that's not between 1-9 but instead 20-8, or 31-9.. given the need at the time.. is there a quick adjustments I can make

There definitely is not a "quick adjustment". In fact, I don't know how it would even work. You previously stated ..

Chlwls808 said:
The internal grid is always 3x3.

.. and as I understood it the digits 1-9 were placed in the appropriate cell in that 3x3 grid with the number 1 starting at the top right then the other numbers across each row in succession. to 9 in the bottom right cell. So I have no idea where 20 or 31 would go in that 3x3 grid?

Chlwls808 said:
"Run-time error '1004': To do this, all the merged cells need to be the same size."

I cannot recall any mention of merged cells earlier in the thread and merged cells and vba code often do not sit well together. What is merged?

tonyyy · Sep 9, 2021

Thanks for stepping in, Peter. I'm always amazed at your code, and always learn something new. I like the way you use Areas to determine contiguous ranges; I'm filing that away for future use for sure.

I've continued to play with the Named Range approach, and while it still requires some manual intervention, it might provide the "quick adjustment" that Chlwls808 is looking for.

To start, I have two sheets in my workbook. The first is named "List" and contains the alphanumeric list of maps starting in A1. The second is named "Map" and contains the grid of named ranges. To create the grid of named ranges:

VBA Code:

Sub CreateNamedRangeGrid()
''' Creates a grid xTall by xWide, with each grid/block composed of 9 cells
Dim wide As Long, tall As Long
Dim rng As Range, cel As Range
Dim rngName As String
Dim r As Long, c As Long, i As Long, block1 As Long, block2 As Long
Dim x As Long, y As Long
Application.ScreenUpdating = False

''' User input for grid size
i = 1       'Sets first block color
tall = 26
wide = 26   'Cannot exceed 26
x = 3       '3x3 grid
y = 1       'Start tall
block1 = tall

''' Creates the grid and adds named ranges
For r = y To tall * x Step x
    For c = 1 To wide * x Step x
        Set rng = Range(Cells(r - (y - 1), c), Cells(r - (y - 1) + (x - 1), c + (x - 1)))
        If c > 3 Then
            block2 = ((c - 1) / x) + 1
        Else
            block2 = c
        End If
        ThisWorkbook.Names.Add Name:="\" & block1 & "A" & Chr(block2 + 64), RefersTo:=ActiveSheet.Range(rng.Address)
        If i > 56 Then i = 1
        With rng.Interior
            .ColorIndex = i
            .TintAndShade = 0.799981688894314
        End With
        i = i + 1
        For Each cel In rng
            cel.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
        Next cel
    Next c
    block1 = block1 - 1
    If block1 < y Then Exit For
Next r

Application.ScreenUpdating = True
End Sub

The following snippet provides the user an easy way to change the grid size:

VBA Code:

tall = 26
wide = 26   'Cannot exceed 26
x = 3       '3x3 grid
y = 1       'Start tall

"tall" refers to the number of 3x3 grids in height; "wide" the number of 3x3 grids in width. (I think of a 3x3 grid as a block.) "y" is the starting number of a range of blocks. So if the user wants something 8 to 20, 20 would the value for tall and 8 would be the value for y.

If you want to delete the grid of named ranges:

VBA Code:

Sub deleteNamedRangeGrid()
''' Deletes named ranges and formatting
Dim nm As Name
Dim sht2 As String
Application.ScreenUpdating = False
sht2 = "Map"

For Each nm In ThisWorkbook.Names
    If nm.RefersToRange.Parent.Name = Sheets(sht2).Name Then nm.Delete
Next nm

With Sheets(sht2).Cells.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

With Sheets(sht2).Cells
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Application.ScreenUpdating = True
End Sub

To fill the map with the list input:

VBA Code:

Sub FillMap2()
Dim nm As Name
Dim r1 As Range, r2 As Range
Dim i As Long
Dim sht1 As String, sht2 As String

Application.ScreenUpdating = False
sht1 = "List"
sht2 = "Map"

For Each r1 In Sheets(sht1).Range("A1:A" & Sheets(sht1).Cells(Rows.Count, "A").End(xlUp).Row)
    For Each nm In ActiveWorkbook.Names
        If nm.RefersToRange.Parent.Name = Sheets(sht2).Name Then
            If Left(r1.Value, 3) = Mid(nm.Name, 2, 3) Then
                Set r2 = Range(nm).Cells(1, 1)
                i = 2
                Do Until i = Len(r1)
                    i = i + 1
                    If Mid((r1), i, 1) = 1 Then r2.Offset(0, 0) = 1
                    If Mid((r1), i, 1) = 2 Then r2.Offset(0, 1) = 2
                    If Mid((r1), i, 1) = 3 Then r2.Offset(0, 2) = 3
                    If Mid((r1), i, 1) = 4 Then r2.Offset(1, 0) = 4
                    If Mid((r1), i, 1) = 5 Then r2.Offset(1, 1) = 5
                    If Mid((r1), i, 1) = 6 Then r2.Offset(1, 2) = 6
                    If Mid((r1), i, 1) = 7 Then r2.Offset(2, 0) = 7
                    If Mid((r1), i, 1) = 8 Then r2.Offset(2, 1) = 8
                    If Mid((r1), i, 1) = 9 Then r2.Offset(2, 2) = 9
                Loop
            End If
        End If
    Next nm
Next r1
Application.ScreenUpdating = True
End Sub

This seems to work for entries with a single digit followed by two alpha characters... as we have in the sample list. It'll probably break with 2 digits and 2 alphas, so it'd be good to get a sample list here.

Once the numbers are mapped to the grid, the user selects a group and runs the following (and repeats for additional groups):

VBA Code:

Sub MapGroup()
Dim Group As Range, rng As Range
Dim str2 As String, str3 As String
Dim nm As Name
Dim LastRow As Long, LastCol As Long
Dim sht1 As String, sht2 As String

Application.ScreenUpdating = False
Set Group = Selection
sht1 = "List"
sht2 = "Map"
LastCol = Sheets(sht1).Cells(1, Columns.Count).End(xlToLeft).Column

''' Loop thru named ranges
For Each nm In ActiveWorkbook.Names
    str2 = ""
    ''' Specify named ranges on the active sheet only
    If nm.RefersToRange.Parent.Name = Sheets(sht2).Name Then
        ''' If a cell in the Selection is within a named range then add the cell value to a list
        For Each rng In Group
            If Not Intersect(Range(nm.Name), rng) Is Nothing Then
                str2 = str2 & rng.Value
            End If
        Next rng
        ''' Add the range name to the list and write the list to the worksheet
        If str2 <> "" Then
            str3 = Right(nm.Name, 3) & str2
            LastRow = Sheets(sht1).Cells(Rows.Count, LastCol + 1).End(xlUp).Row
            If Sheets(sht1).Cells(LastRow, LastCol + 1) = "" Then
                Sheets(sht1).Cells(LastRow, LastCol + 1) = str3
            Else
                Sheets(sht1).Cells(LastRow + 1, LastCol + 1) = str3
            End If
        End If
    End If
Next nm

''' Sort the list
Sheets(sht1).Activate
Sheets(sht1).Range(Sheets(sht1).Cells(1, LastCol + 1), Sheets(sht1).Cells(LastRow + 1, LastCol + 1)).Select
Selection.TextToColumns Destination:=Sheets(sht1).Cells(1, LastCol + 1), DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 1), Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Sheets(sht1).Range(Cells(1, LastCol + 1), Cells(LastRow + 1, LastCol + 3)).Sort key1:=Cells(1, LastCol + 1), _
    key2:=Cells(1, LastCol + 2), order1:=xlDescending, order2:=xlAscending, Header:=xlNo
Selection.Offset(0, 3).FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2],RC[-1])"
Selection.Offset(0, 3).Value = Selection.Offset(0, 3).Value
Selection = Selection.Offset(0, 3).Value
Selection.Resize(, 3).Offset(0, 1).Delete

Application.ScreenUpdating = True
End Sub

(I know, it's not the most succinct or efficient code.)

That's my story...

Chlwls808 · Sep 9, 2021

Peter_SSs said:
There definitely is not a "quick adjustment". In fact, I don't know how it would even work. You previously stated ..

.. and as I understood it the digits 1-9 were placed in the appropriate cell in that 3x3 grid with the number 1 starting at the top right then the other numbers across each row in succession. to 9 in the bottom right cell. So I have no idea where 20 or 31 would go in that 3x3 grid?

Sorry Peter, I guess I wasn't clear enough. I wasn't referring to the 3x3 grid, but instead the first digit we are using in the alphanumeric combination. Since you aren't using the named ranges, I was curious how you would apply other sample data that might not begin with 1 through 9, but maybe in other group of numbers that fit the vertical order of the grids.

I cannot recall any mention of merged cells earlier in the thread and merged cells and vba code often do not sit well together. What is merged?

I'm not sure either. This error pops out on me. I will try to figure it out since it seems like it's only happening on my side.

Chlwls808 · Sep 9, 2021

tonyyy said:

Thanks for stepping in, Peter. I'm always amazed at your code, and always learn something new. I like the way you use Areas to determine contiguous ranges; I'm filing that away for future use for sure.

I've continued to play with the Named Range approach, and while it still requires some manual intervention, it might provide the "quick adjustment" that Chlwls808 is looking for.

To start, I have two sheets in my workbook. The first is named "List" and contains the alphanumeric list of maps starting in A1. The second is named "Map" and contains the grid of named ranges. To create the grid of named ranges:

VBA Code:

Sub CreateNamedRangeGrid()
''' Creates a grid xTall by xWide, with each grid/block composed of 9 cells
Dim wide As Long, tall As Long
Dim rng As Range, cel As Range
Dim rngName As String
Dim r As Long, c As Long, i As Long, block1 As Long, block2 As Long
Dim x As Long, y As Long
Application.ScreenUpdating = False

''' User input for grid size
i = 1       'Sets first block color
tall = 26
wide = 26   'Cannot exceed 26
x = 3       '3x3 grid
y = 1       'Start tall
block1 = tall

''' Creates the grid and adds named ranges
For r = y To tall * x Step x
    For c = 1 To wide * x Step x
        Set rng = Range(Cells(r - (y - 1), c), Cells(r - (y - 1) + (x - 1), c + (x - 1)))
        If c > 3 Then
            block2 = ((c - 1) / x) + 1
        Else
            block2 = c
        End If
        ThisWorkbook.Names.Add Name:="\" & block1 & "A" & Chr(block2 + 64), RefersTo:=ActiveSheet.Range(rng.Address)
        If i > 56 Then i = 1
        With rng.Interior
            .ColorIndex = i
            .TintAndShade = 0.799981688894314
        End With
        i = i + 1
        For Each cel In rng
            cel.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
        Next cel
    Next c
    block1 = block1 - 1
    If block1 < y Then Exit For
Next r

Application.ScreenUpdating = True
End Sub

The following snippet provides the user an easy way to change the grid size:

VBA Code:

tall = 26
wide = 26   'Cannot exceed 26
x = 3       '3x3 grid
y = 1       'Start tall

"tall" refers to the number of 3x3 grids in height; "wide" the number of 3x3 grids in width. (I think of a 3x3 grid as a block.) "y" is the starting number of a range of blocks. So if the user wants something 8 to 20, 20 would the value for tall and 8 would be the value for y.

If you want to delete the grid of named ranges:

VBA Code:

Sub deleteNamedRangeGrid()
''' Deletes named ranges and formatting
Dim nm As Name
Dim sht2 As String
Application.ScreenUpdating = False
sht2 = "Map"

For Each nm In ThisWorkbook.Names
    If nm.RefersToRange.Parent.Name = Sheets(sht2).Name Then nm.Delete
Next nm

With Sheets(sht2).Cells.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

With Sheets(sht2).Cells
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
Application.ScreenUpdating = True
End Sub

To fill the map with the list input:

VBA Code:

Sub FillMap2()
Dim nm As Name
Dim r1 As Range, r2 As Range
Dim i As Long
Dim sht1 As String, sht2 As String

Application.ScreenUpdating = False
sht1 = "List"
sht2 = "Map"

For Each r1 In Sheets(sht1).Range("A1:A" & Sheets(sht1).Cells(Rows.Count, "A").End(xlUp).Row)
    For Each nm In ActiveWorkbook.Names
        If nm.RefersToRange.Parent.Name = Sheets(sht2).Name Then
            If Left(r1.Value, 3) = Mid(nm.Name, 2, 3) Then
                Set r2 = Range(nm).Cells(1, 1)
                i = 2
                Do Until i = Len(r1)
                    i = i + 1
                    If Mid((r1), i, 1) = 1 Then r2.Offset(0, 0) = 1
                    If Mid((r1), i, 1) = 2 Then r2.Offset(0, 1) = 2
                    If Mid((r1), i, 1) = 3 Then r2.Offset(0, 2) = 3
                    If Mid((r1), i, 1) = 4 Then r2.Offset(1, 0) = 4
                    If Mid((r1), i, 1) = 5 Then r2.Offset(1, 1) = 5
                    If Mid((r1), i, 1) = 6 Then r2.Offset(1, 2) = 6
                    If Mid((r1), i, 1) = 7 Then r2.Offset(2, 0) = 7
                    If Mid((r1), i, 1) = 8 Then r2.Offset(2, 1) = 8
                    If Mid((r1), i, 1) = 9 Then r2.Offset(2, 2) = 9
                Loop
            End If
        End If
    Next nm
Next r1
Application.ScreenUpdating = True
End Sub

This seems to work for entries with a single digit followed by two alpha characters... as we have in the sample list. It'll probably break with 2 digits and 2 alphas, so it'd be good to get a sample list here.

Once the numbers are mapped to the grid, the user selects a group and runs the following (and repeats for additional groups):

VBA Code:

Sub MapGroup()
Dim Group As Range, rng As Range
Dim str2 As String, str3 As String
Dim nm As Name
Dim LastRow As Long, LastCol As Long
Dim sht1 As String, sht2 As String

Application.ScreenUpdating = False
Set Group = Selection
sht1 = "List"
sht2 = "Map"
LastCol = Sheets(sht1).Cells(1, Columns.Count).End(xlToLeft).Column

''' Loop thru named ranges
For Each nm In ActiveWorkbook.Names
    str2 = ""
    ''' Specify named ranges on the active sheet only
    If nm.RefersToRange.Parent.Name = Sheets(sht2).Name Then
        ''' If a cell in the Selection is within a named range then add the cell value to a list
        For Each rng In Group
            If Not Intersect(Range(nm.Name), rng) Is Nothing Then
                str2 = str2 & rng.Value
            End If
        Next rng
        ''' Add the range name to the list and write the list to the worksheet
        If str2 <> "" Then
            str3 = Right(nm.Name, 3) & str2
            LastRow = Sheets(sht1).Cells(Rows.Count, LastCol + 1).End(xlUp).Row
            If Sheets(sht1).Cells(LastRow, LastCol + 1) = "" Then
                Sheets(sht1).Cells(LastRow, LastCol + 1) = str3
            Else
                Sheets(sht1).Cells(LastRow + 1, LastCol + 1) = str3
            End If
        End If
    End If
Next nm

''' Sort the list
Sheets(sht1).Activate
Sheets(sht1).Range(Sheets(sht1).Cells(1, LastCol + 1), Sheets(sht1).Cells(LastRow + 1, LastCol + 1)).Select
Selection.TextToColumns Destination:=Sheets(sht1).Cells(1, LastCol + 1), DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 1), Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Sheets(sht1).Range(Cells(1, LastCol + 1), Cells(LastRow + 1, LastCol + 3)).Sort key1:=Cells(1, LastCol + 1), _
    key2:=Cells(1, LastCol + 2), order1:=xlDescending, order2:=xlAscending, Header:=xlNo
Selection.Offset(0, 3).FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2],RC[-1])"
Selection.Offset(0, 3).Value = Selection.Offset(0, 3).Value
Selection = Selection.Offset(0, 3).Value
Selection.Resize(, 3).Offset(0, 1).Delete

Application.ScreenUpdating = True
End Sub

(I know, it's not the most succinct or efficient code.)

That's my story...

Thanks Tony, wow, this is an upgrade from the previous one. A time-saver on the name range, too. I'll mess with this and let you know if I run into trouble.

Chlwls808 · Sep 9, 2021

tonyyy said:
This seems to work for entries with a single digit followed by two alpha characters... as we have in the sample list. It'll probably break with 2 digits and 2 alphas, so it'd be good to get a sample list here.

Can we try a 2 digit number sample being 90, 91, 92, 93, 94, 95, 96, 97, 98?

Peter_SSs · Sep 9, 2021

Chlwls808 said:
Say I want to cater to numbers that's not between 1-9 but instead 20-8, or 31-9..

Chlwls808 said:
Sorry Peter, I guess I wasn't clear enough. I wasn't referring to the 3x3 grid, but instead the first digit we are using in the alphanumeric combination. Since you aren't using the named ranges, I was curious how you would apply other sample data that might not begin with 1 through 9, but maybe in other group of numbers that fit the vertical order of the grids.

Chlwls808 said:
Can we try a 2 digit number sample being 90, 91, 92, 93, 94, 95, 96, 97, 98?

I assume that the above quotes relate to the same thing?
Can you explain and give examples, including location, of what 20-8 or 90, 91, 92, 93, 94, 95, 96, 97, 98 actually means?

Chlwls808 said:
I'm not sure either. This error pops out on me. I will try to figure it out since it seems like it's only happening on my side.

It certainly is not happening for me.

Select a single cell somewhere on the sheet
Ctrl+F to bring up the Find dialog
Find what: leave blank, make sure Options>> is expanded, click the down arrow beside Format..., if 'Clear Find Format is not greyed out then click it & then the down arrow again and choose Format..., put a tick beside merge cells,

, OK, Find All
If the sheet has merged cells you should see something like this that identifies where they are

Categorizing group of numbers which depicts an area coverage on a grid map

Chlwls808

Board Regular

Peter_SSs

MrExcel MVP, Moderator

Excel Facts

Chlwls808

Board Regular

Chlwls808

Board Regular

Chlwls808

Board Regular

Peter_SSs

MrExcel MVP, Moderator

tonyyy

Well-known Member

Chlwls808

Board Regular

Chlwls808

Board Regular

Chlwls808

Board Regular

Peter_SSs

MrExcel MVP, Moderator

Forum statistics

Share this page

Categorizing group of numbers which depicts an area coverage on a grid map

Board Regular

MrExcel MVP, Moderator

Excel Facts

Board Regular

Board Regular

Board Regular

MrExcel MVP, Moderator

Well-known Member

​

Board Regular

Board Regular

​

Board Regular

MrExcel MVP, Moderator

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock