Macro or VBA to format jumbled sheet

Keegan4123

New Member
Joined
Mar 30, 2022
Messages
29
Office Version
  1. 2016
Platform
  1. Windows
We have a sheet that we get from a client daily or every 2nd day. They used to have it formatted in a way that worked well with our system and could easily get the information we needed. However they have recently changed the output and its causing alot of manual manipulation and room for error. I have attached a mini sheet so you can all see how it comes in, and the ultimate output. The issue is the groups of rows can change daily for how many are in each, which makes a recorded macro not useable. The sheet used to have the ID listed first, and then the form type (observation, near miss, hazard ID) next to that. Now they are lumping all together and using a same column label. This obviously doesnt work for us because we have various lookups that reference the form type cells in order to pull other data. The ID is not needed, and we have just been filling down and deleting, but its manual, and takes time. With the chance for mistake we don't want to rely on that.

Workbook help.xlsx
ABCDEFGHIJKLM
1Raw Data Example
2Observation
3ID#Date submittedSubmitterSubjectLocationTagsThe distribution between these different types varies from day to day, and if the report is run over multiple days. So a standard macro record wont work because of the inconsistencies
4474922022-07-14T17:59:02Submitter 1Subject InfoLocation Info
5474052022-07-14T16:27:09Submitter 2Subject InfoLocation Info
6474032022-07-14T16:24:54Submitter 3Subject InfoLocation Info
7473472022-07-14T15:55:45Submitter 4Subject InfoLocation Info
8473232022-07-14T15:46:37Submitter 5Subject InfoLocation Info
9473112022-07-14T15:39:49Submitter 6Subject InfoLocation Info
10473092022-07-14T15:36:00Submitter 7Subject InfoLocation Info
11472762022-07-14T15:02:51Submitter 8Subject InfoLocation Info
12472372022-07-14T14:40:13Submitter 9Subject InfoLocation Info
13471812022-07-14T13:36:23Submitter 10Subject InfoLocation Info
14471632022-07-14T13:08:29Submitter 11Subject InfoLocation Info
15471612022-07-14T13:07:17Submitter 12Subject InfoLocation Info
16471372022-07-14T12:40:15Submitter 13Subject InfoLocation Info
17470742022-07-14T10:38:47Submitter 14Subject InfoLocation Info
18
19Near Miss
20ID#Date submittedSubmitterSubjectLocationTags
21475622022-07-14T23:14:48Submitter 17Subject InfoLocation Info
22
23Hazard ID
24ID#Date submittedSubmitterSubjectLocationTags
25475322022-07-14T19:14:42Submitter 22Subject InfoLocation Info
26470942022-07-14T11:37:38Submitter 23Subject InfoLocation Info
27
28Corrected and filtered Data Example
29Observation2022-07-14T17:59:02Submitter 1Subject InfoLocation Info
30Observation2022-07-14T16:27:09Submitter 2Subject InfoLocation Info
31Observation2022-07-14T16:24:54Submitter 3Subject InfoLocation Info
32Observation2022-07-14T15:55:45Submitter 4Subject InfoLocation Info
33Observation2022-07-14T15:46:37Submitter 5Subject InfoLocation Info
34Observation2022-07-14T15:39:49Submitter 6Subject InfoLocation Info
35Observation2022-07-14T15:36:00Submitter 7Subject InfoLocation Info
36Observation2022-07-14T15:02:51Submitter 8Subject InfoLocation Info
37Observation2022-07-14T14:40:13Submitter 9Subject InfoLocation Info
38Observation2022-07-14T13:36:23Submitter 10Subject InfoLocation Info
39Observation2022-07-14T13:08:29Submitter 11Subject InfoLocation Info
40Observation2022-07-14T13:07:17Submitter 12Subject InfoLocation Info
41Observation2022-07-14T12:40:15Submitter 13Subject InfoLocation Info
42Observation2022-07-14T10:38:47Submitter 14Subject InfoLocation Info
43Near Miss2022-07-14T23:14:48Submitter 17Subject InfoLocation Info
44Hazard ID2022-07-14T19:14:42Submitter 22Subject InfoLocation Info
45Hazard ID2022-07-14T11:37:38Submitter 23Subject InfoLocation Info
Raw Data
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
sorry, was going to ask a question that I see you answered already. apologies.
 
Upvote 0
Hi, can I ask, is it correct that you no longer care about the Hazard ID, or Observation ID number in your output ?
thanks
Rob
Exactly, the Form ID is irrelevant to us. Just the actual form classification, if we can keep the ID great, but if not I don't care. Right now we aren't cause I am just using the fill handle down for each class and it overwrites.
 
Upvote 0
ah ok, so if you wanted the ID, is it ok to put it in col B and push the rest out, or would you prefer it to go elsewhere ?

this isnt straightforward, but it should be possible ..
Rob
 
Upvote 0
ah ok, so if you wanted the ID, is it ok to put it in col B and push the rest out, or would you prefer it to go elsewhere ?

this isnt straightforward, but it should be possible ..
Rob
Yeh column B would be fine, with the form type in column A
 
Upvote 0
Hi Keegan,

see how you get on with this :
VBA Code:
Sub Data_sort()

Dim datalastrow, x, y As Long
Dim observation_start, hazard_id_start, near_miss_start As Long


    'insert a column in A
    Columns("A:A").Select
    Range("A2").Activate
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove


datalastrow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row ' find the last row of data in Col B

'scan all data rows, looking for "Form Type" headers
For x = 1 To datalastrow

    If Cells(x, 2) = "Observation" Then
        observation_start = x + 2 'we found Observations, so mark the starting row
    End If
    
    If Cells(x, 2) = "Near Miss" Then
        near_miss_start = x + 2
        
        'populate observation rows
        For y = observation_start To near_miss_start - 4
            Cells(y, 1) = "Observation"
        Next y
        
    End If
    
    If Cells(x, 2) = "Hazard ID" Then
        hazard_id_start = x + 2
        
        'populate Near Miss rows
        For y = near_miss_start To hazard_id_start - 4
            Cells(y, 1) = "Near Miss"
        Next y
        
        'populate Hazard ID rows
        For y = hazard_id_start To datalastrow
            Cells(y, 1) = "Hazard ID"
        Next y
        
        Exit For 'no need to look for other form types as all three found. Exit for x loop
    End If
    
Next x

        'delete all unwanted rows below
        Range(Cells(hazard_id_start - 1, 1), Cells(hazard_id_start - 1, 1)).EntireRow.Delete
        Range(Cells(hazard_id_start - 2, 1), Cells(hazard_id_start - 2, 1)).EntireRow.Delete
        Range(Cells(hazard_id_start - 3, 1), Cells(hazard_id_start - 3, 1)).EntireRow.Delete
        
        Range(Cells(near_miss_start - 1, 1), Cells(near_miss_start - 1, 1)).EntireRow.Delete
        Range(Cells(near_miss_start - 2, 1), Cells(near_miss_start - 2, 1)).EntireRow.Delete
        Range(Cells(near_miss_start - 3, 1), Cells(near_miss_start - 3, 1)).EntireRow.Delete
        
        Range(Cells(observation_start - 1, 1), Cells(observation_start - 1, 1)).EntireRow.Delete
        Range(Cells(observation_start - 2, 1), Cells(observation_start - 2, 1)).EntireRow.Delete
       
End Sub
 
Upvote 0
Another option
VBA Code:
Sub Keegan()
   Dim Rng As Range
   
   Range("A:A").Insert
   For Each Rng In Range("B1", Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
      Rng.Offset(2, -1).Resize(Rng.Count - 2).Value = Rng.Resize(1).Value
   Next Rng
   Range("A2").Value = "ID"
   Range("A:A").SpecialCells(xlBlanks).EntireRow.Delete
End Sub
 
Upvote 0
Hi Keegan,

see how you get on with this :
VBA Code:
Sub Data_sort()

Dim datalastrow, x, y As Long
Dim observation_start, hazard_id_start, near_miss_start As Long


    'insert a column in A
    Columns("A:A").Select
    Range("A2").Activate
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove


datalastrow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row ' find the last row of data in Col B

'scan all data rows, looking for "Form Type" headers
For x = 1 To datalastrow

    If Cells(x, 2) = "Observation" Then
        observation_start = x + 2 'we found Observations, so mark the starting row
    End If
   
    If Cells(x, 2) = "Near Miss" Then
        near_miss_start = x + 2
       
        'populate observation rows
        For y = observation_start To near_miss_start - 4
            Cells(y, 1) = "Observation"
        Next y
       
    End If
   
    If Cells(x, 2) = "Hazard ID" Then
        hazard_id_start = x + 2
       
        'populate Near Miss rows
        For y = near_miss_start To hazard_id_start - 4
            Cells(y, 1) = "Near Miss"
        Next y
       
        'populate Hazard ID rows
        For y = hazard_id_start To datalastrow
            Cells(y, 1) = "Hazard ID"
        Next y
       
        Exit For 'no need to look for other form types as all three found. Exit for x loop
    End If
   
Next x

        'delete all unwanted rows below
        Range(Cells(hazard_id_start - 1, 1), Cells(hazard_id_start - 1, 1)).EntireRow.Delete
        Range(Cells(hazard_id_start - 2, 1), Cells(hazard_id_start - 2, 1)).EntireRow.Delete
        Range(Cells(hazard_id_start - 3, 1), Cells(hazard_id_start - 3, 1)).EntireRow.Delete
       
        Range(Cells(near_miss_start - 1, 1), Cells(near_miss_start - 1, 1)).EntireRow.Delete
        Range(Cells(near_miss_start - 2, 1), Cells(near_miss_start - 2, 1)).EntireRow.Delete
        Range(Cells(near_miss_start - 3, 1), Cells(near_miss_start - 3, 1)).EntireRow.Delete
       
        Range(Cells(observation_start - 1, 1), Cells(observation_start - 1, 1)).EntireRow.Delete
        Range(Cells(observation_start - 2, 1), Cells(observation_start - 2, 1)).EntireRow.Delete
      
End Sub
Thank you soo much, works exactly.


Ran it on a sheet and forgot a couple of column types. Can you add LPO into there as well?
 
Upvote 0
Did you try my code? It will pick up all the different types.
 
Upvote 0

Forum statistics

Threads
1,216,099
Messages
6,128,813
Members
449,469
Latest member
Kingwi11y

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