Excel VBA Somewhat Pivoting Data - Seems so simple but I'm losing my mind

[kjv1611]

I probably just am just going a little batty at the moment. Surely there's something real simple I'm missing.

If anyone has an idea how to rearrange my logic or hit me up side the head with a brick, I'll take any "help".

We have a CSV output file that I need to keep a portion of the data and sort of pivot it (only it doesn't really work for a pivot table, and thus why I'm writing VBA).

The data I need to use looks like this:

Label     Element          Flags     Data
Blank     Ag 328.068       [Empty]     0
Blank     Al 396.152       [Empty]     0
Blank     As 188.980       [Empty]     0
Blank     As 193.696       [Empty]     0
Blank     B 208.956        [Empty]     0
Blank     B 249.678        [Empty]     0
Blank     Ba 233.527       [Empty]     0
Blank     Ba 455.403       [Empty]     0
Blank     Be 313.042       [Empty]     0
Blank     Ca 315.887       [Empty]     0
Blank     Ca 393.366       [Empty]     0
Blank     Ca 422.673       [Empty]     0
20 ppm     Y 224.303     [Empty]     0.9451
20 ppm     Y 371.029     [Empty]     0.9357
20 ppm     Y 371.029     [Empty]     0.935
20 ppm     Zn 206.200     [Empty]     20
20 ppm     Zn 213.857     [Empty]     --
20 ppm     Zn 334.502     [Empty]     20
PBlnk     Ag 328.068     Y!         0.0615
PBlnk     Al 396.152     !         0.0006
PBlnk     As 188.980     !         0.0054
PBlnk     As 193.696     !         0.0041
PBlnk     B 208.956     !u         0.0009
PBlnk     B 249.678     !u         -0.0052
PBlnk     Ba 233.527     !u         -0.0001
PBlnk     Ba 455.403     !u         -0.0001
PBlnk     Be 313.042     !u            0
PBlnk     Ca 315.887     Y!         0.0576

And then LOTS more of it. So there are MANY Elements per Label, and typical 1 to 4 Data points (4th column or column D for easier reference) for each Element. There could be a flag for any given Label-Element point that shows what's wrong with the Data column.

What I've already done (this much works):
I've deduped the Label column in a new sheet so we can have one row per Label.
I've deduped the Element column and put it across the top row (B1 to the right, however many columns needed) for Column headers

That part works great.

Where I've goofed in logic somehow is telling Excel:
1. Whenever there's a Flag in column C from original Sheet, FIRST append that to a variable to concatenate multiple flags with their Data values.
Example: if there are 2 data values for one Element that have a flag, then it could be a string of 000.23 Y, 000.54 Z
2. Once I've found the flags for a particular Label,Element combo, whether that be 1, 2, 3, or 4, paste the stored variable value into the proper "grid" location on the new worksheet.
3. Move on to the next Label/Element pair.

My logic finds the flags.

However, my logic goes wonky on finding where to plug in the flags. For some reason I've got it plugging in flag values where there should be just blank/empty cells (if no flags, we're leaving the new cells blank).

My messy code:

Sub PivotMyData()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wsNew As Worksheet
    Dim wsClean As Worksheet [green]'to just clean up the Elements[/green]
    Dim lRowO As Long [green]'Origin sheet Row[/green]
    Dim lRowN As Long [green]'New sheet row[/green]
    Dim iColN As Integer [green]'New sheet col[/green]
    Dim strLabel As String [green]'Label value from sheet[/green]
    Dim strElement As String [green]'Element (to go across column headers)[/green]
    Dim strResult As String [green]'Result (Unadjusted Data + " " + flag)
        'strResult should start as null string then add to it as find flags per element per label[/green]
    Dim strCurrRes As String [green]' in case need to capture each one separately...[/green]
    Dim rLastElement As Range [green]'last Element range looked at.[/green]
    Dim rLastFlag As Range [green]'last flag found[/green]
    Dim lFindNextRow As Long
    Dim rAnchor As Range [green]'anchor will be cell A1 in new worksheet for ease of reference.[/green]
    
    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet

[green]'delete the first two rows from CSV as they just get in way[/green]
    ws.Rows(1).EntireRow.Delete
    ws.Rows(1).EntireRow.Delete
    
[green]'Save the file as an Excel file[/green]
    ActiveWorkbook.SaveAs Filename:= _
        Replace(wb.FullName, ".csv", ".xlsx"), FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False

[green]'Delete unnecessary columns[/green]
    ws.Columns("H:AH").EntireColumn.Delete
    ws.Columns("E").EntireColumn.Delete
    ws.Columns("B:C").EntireColumn.Delete
    
[green]'Sort the data to ensure things are definitely lined up properly - we may be able to prove this is not needed later, but want to add for now to be safe.[/green]
    ws.Range("A1").CurrentRegion.Select
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add2 Key:= _
        Range("A2:A14911"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ws.Sort.SortFields.Add2 Key:= _
        Range("B2:B14911"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ws.Sort.SortFields.Add2 Key:= _
        Range("D2:D14911"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ws.Sort
        .SetRange Range("A1:D14911")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
[green]' Add new worksheet for viewing the data differently - in the QC layout[/green]
    Set wsNew = wb.Worksheets.Add
    Set wsClean = wb.Worksheets.Add 'to clean up labels
    
[green]' Rename the new sheets[/green]
    wsNew.Name = "ICP QC"
    wsClean.Name = "CleanUP"
    
    
[green]'******************* Main parts of code for getting data into workable layout *********************

'****************************
' ----------- 01 Grab Elements to use as a COLUMN headers.
'****************************

    ' copy the Element data to the new worksheet[/green]
    ws.Range("B2:B" & ws.Range("B999999").End(xlUp).Row).Copy wsNew.Range("A2")
    
    ' remove duplicates
    wsNew.UsedRange.RemoveDuplicates 1, xlNo
  
    [green]' Remove blank cells (we don't want blank column headers if any blank values exist[/green]
On Error Resume Next
        ws.UsedRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp
On Error GoTo 0
    
[green]    ' copy the range to now be the column headers[/green]
    wsNew.Range("A2:A" & ws.Range("A999999").End(xlUp).Row).Copy
[green]    ' transpose to the header row starting with column B[/green]
    wsNew.Range("B1").PasteSpecial Transpose:=True
[green]    ' delete the original pasted data from Column A[/green]
    wsNew.Range("A2:A" & wsNew.Range("A999999").End(xlUp).Row).Delete xlShiftUp

[green]'****************************
' ----------- 02 Grab the Labels to be used as ROW headers.
'****************************
    ' copy the Label data to the new worksheet[/green]
    ws.Range("A2:A" & ws.Range("A999999").End(xlUp).Row).Copy wsClean.Range("A2")
[green]    ' remove duplicates[/green]
    wsClean.UsedRange.RemoveDuplicates 1, xlNo
[green]'   Copy the cleaned data to wsNew for QC data (copy to A2 for column headers (Labels)[/green]
    wsClean.Range("A2:A" & wsClean.Range("A999999").End(xlUp).Row).Copy wsNew.Range("A2")

[green]    ' THERE IS NO WAY THERE WOULD BE BLANKS IN LABELS So can skip checking for blanks

'   strLabel = Label value from sheet
'   strElement = Element (to go across column headers)
'   strResult = Result (Unadjusted Data + " " + flag)
'   strCurrRes = in case need to capture each one separately...

[highlight #FCE94F]' *************************************************************************************************************************
' *************************************************************************************************************************
' *************************************************************************************************************************
' *************************************************************************************************************************
' ***** BELOW IS SECTION WHERE THE LOGIC MESS CURRENTLY EXISTS THAT I NEED TO FIX ****************************************
' *************************************************************************************************************************
' *************************************************************************************************************************
' *************************************************************************************************************************[/highlight]


'****************************
' ----------- 03 POPULATE THE flag and Result where it fits
' NOW THAT I HAVE COLUMN AND ROW HEADERS, POPULATE THE flag and Result where it fits
' for that need to loop through original data (ws) and fill where fits on new data (wsNew)
' To do this right, will build each value now in the loop that was goign to be original logic by finding all possible values for each Row and each column in new data
'****************************
[/green]
    Set rAnchor = wsNew.Range("A1") 'for easier reference

    lRowO = 1 [green]'start from the header row b/c always searching for the next found row of data[/green]
    
    Do Until lRowO = ws.Range("C999999").End(xlUp).Row
[green]' this section gets us to each flag so we don't have to actually look at every single row of data[/green]
        lFindNextRow = ws.Range("C3").EntireColumn.Find(What:="?*", After:=Range("C" & lRowO), LookIn:=xlValues).Row
        If lFindNextRow <= 1 Then lFindNextRow = 0
        lRowO = lFindNextRow

[green]    ' set the initial value[/green]
        If strResult = vbNullString Then strResult = ws.Range("D" & lRowO).Value & " " & ws.Range("C" & lRowO).Value
        If strLabel = vbNullString Then strLabel = ws.Range("A" & lRowO).Value
        If strElement = vbNullString Then strElement = ws.Range("B" & lRowO).Value

[green]'   If the Label for that element is same as the current Label working with (strLabel), then add the current result and flag to string variable[/green]
        If ws.Range("B" & lRowO).Value = strElement And ws.Range("A" & lRowO).Value = strLabel Then
[green]            ' If both are the same as what already dealing with, then append the Flag to the strResult variable[/green]
            If strResult = ws.Range("D" & lRowO).Value & " " & ws.Range("C" & lRowO).Value Then
            Else
                strResult = strResult & ", " & ws.Range("D" & lRowO).Value & " " & ws.Range("C" & lRowO).Value
            End If
        Else
[green]            ' If the ELEMENT or the LABEL changes, then I know it's a different record we want to work with, regardless.
            ' When different, this is when need to find where to plug the values
        
            ' find the column and row where to paste the strResult value
        
'Debug.Print "rAnchor = " & rAnchor.Address
'Debug.Print "strLabel = " & strLabel
'Debug.Print "strElment = " & strElement
[/green]
            wsNew.Activate
            rAnchor.Select
            
            lRowN = Cells.Find(What:=strLabel, After:=rAnchor, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
            iColN = Cells.Find(What:=strElement, After:=rAnchor, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Column
    
            wsNew.Cells(lRowN, iColN).Value = strResult
    
[green]    ' clear out the result[/green]
                strResult = vbNullString
[green]    ' repopulate everything according to what the current row in original worksheet is[/green]
                strLabel = ws.Range("A" & lRowO).Value
                strElement = ws.Range("B" & lRowO).Value
                strResult = ws.Range("D" & lRowO).Value & " " & ws.Range("C" & lRowO).Value
        
        End If

[green]' **** End non-empty flag loop[/green]
    Loop [green]'Do Until lRowO = ws.Range("C999999").End(xlUp).Row[/green]

[highlight #FCE94F]' *************************************************************************************************************************
' *************************************************************************************************************************
' *************************************************************************************************************************
' *************************************************************************************************************************
' ***** [b]ABOVE[/b] IS SECTION WHERE THE LOGIC MESS CURRENTLY EXISTS THAT I NEED TO FIX ****************************************
' *************************************************************************************************************************
' *************************************************************************************************************************
' *************************************************************************************************************************[/highlight]
    
    
    wb.Save
On Error Resume Next
    Set rAnchor = Nothing
    Set ws = Nothing
    Set wsNew = Nothing
    Set wb = Nothing

End Sub

I'm still working on this. If anyone has any suggestions whatsoever, I'm all ears. Thanks in advance.

And I can try to fill in more blanks if necessary as well. Hopefully my explanation explained what I"m trying to do.

One option in the back of my mind is using MSQuery, but I am not sure that'll really handle this setup since there are multiple records...


"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[SkipVought]

Hi,

What’s this data representing?

As you stated, if you were to list unique lables in col A and unique elements in row 1, then you’d still have the flag values to contend with.

Rather , I’d query this on a new sheet...
[tt]
Select Distinct lable, flags
...
[/tt]

Add your unique elements in row 1.

Now you will have a valid flag for each lable. Then use SUMPRODUCT() to return the data sum for the lable, flag & element values.

I guess this suggestion is just a PT substitute. So I’m not understanding what results you expect.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[kjv1611]

Brother Skip! I knew you'd be watching and waiting to tell me to write a query. I love the queries, but the couple of times I used them in production, eventually somebody changed something which broke the query which then meant I had to figure out ow to fix it or just rebuild it again. So it left a sour taste in my mouth, unfortunately. Should I just keep fighting to figure it out? Yep. But I didn't have time then, and I have less time now, unfortunately.

The data is raw testing data out of a laboratory machine. It's not anything I know much about though I did take a couple years of chemistry in college.

Label - is the identifier for a "sample" - That is (my understanding) the contents in a container or group of containers (if more than one container of the same). Long name is "solution label"

Element - What element is found/analyzed. So there are oodles of different scientific elements we test and test for. So that could be lead, copper, gold (I suppose), Selenium, and any other elements found in soil and water, pretty much.

Flags - If something is wrong / out of scope about this element within this sample (label), then WHAT is wrong. And there are OODLES of different flags, apparently of which I have no clue what they are. I just see the flags in this scope so far.

Data - is just the actual measurement. So it founds 10 micrograms or .0015 miligrams (not converting between the two examples just making up numbers).

That's my rough understanding. I make no promises as to their accuracy. I'm just asked "take this data and make it look like so."



Now...

If I can make it work via a query with a Pivot as well, then that could work for the time being, I suppose, and I could just have a text copy of the SQL, documented steps, etc, to recreate it again. And then I could work on the VBA piece in the the meantime while having a working solution.

A Pivot table in Excel almost does it, but of course Pivot tables want us to SUM, AVG, COUNT, etc values. In this circumstance, we don't want any count, we just want to show the data "labels". They should all be handled as TEXT. I really hoped to just toss together a Pivot table, and thought it would work until they said, "no, we don't want that.."

Thanks for any ideas - whether off the beaten path or fully sensical.

I'm still guessing there's something simple I'm missing. It's got to be there. Somewhere in how I'm picking up the values from the original sheet from the FLAG column, concatonating them, then plugging itno the new matrix/pivot on the new sheet.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[SkipVought]

Here's a pivot. What's the deficiency?
[pre]
Sum of Data Label Flags
20 ppm Blank PBlnk
Element [Empty] [Empty] ! !u Y!
Ag 328.068 0 0.0615
Al 396.152 0 0.0006
As 188.980 0 0.0054
As 193.696 0 0.0041
B 208.956 0 0.0009
B 249.678 0 -0.0052
Ba 233.527 0 -0.0001
Ba 455.403 0 -0.0001
Be 313.042 0 0
Ca 315.887 0 0.0576
Ca 393.366 0
Ca 422.673 0
Y 224.303 0.9451
Y 371.029 1.8707
Zn 206.200 20
Zn 213.857 0
Zn 334.502 20
[/pre]

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[kjv1611]

Maybe I need to play with that again real quick - but didn't seem like it actually worked yesterday... give me a minute..

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[kjv1611]

So far no go... just doing a pivot table anyway... or are you talking a pivot query?

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[kjv1611]

And sorry so short a response. Was on phone about a different topic altogether and then had to run downstairs to another unrelated item.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[kjv1611]

Any way to think about this in VBA? I'm pretty doggone close at this point.. just gotta fix whatever I'm doing wrong putting the Data and Flag values in the right cells.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[kjv1611]

        lFindNextRow = ws.Range("C3").EntireColumn.Find(What:="?*", After:=Range("C" & lRowO), LookIn:=xlValues).Row
        If lFindNextRow <= 1 Then lFindNextRow = 0
        lRowO = lFindNextRow

For a moment, I thought this was the main problem, but I think I just jumped to conclusions b/c in a hurry. Let me keep testing to verify..

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[kjv1611]

Alright, just put a hold on this one if anyone is trying to figure it out / do anything differently.

After some additional testing, I verified at least ONE problem is in the data. I was told in the meeting with the Lab folks when we looked at the exported CSV file that I could narrow it down to: Label, Element, Data, and Flag. Well, now I figure out that's NOT the case. And of course when I ask about it, it seems I'm speaking a different language. So we've got to go a different route since I can't get anything on that end from those asking for help.

I'll post back here with whatever ends up being the solution to at least close this one out.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[SkipVought]

It’s just a run of the mill PT.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[SkipVought]

eventually somebody changed something which broke the query

The things that can break a query are usually that the connection somehow changes.

In the instances when the query is to a workbook, often ThisWorkbook (the one yer in), you need a method to change that path/name each time the query is run. I ALWAYS code my queries and run the code any time the query is run.

Dim sPath As String, sDB As String

sPath = ThisWorkbook.Path
sDB = ThisWorkbook.Name

And then substitute the path and name in each place you fine them in the Query.Connection and Query.SQL.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[kjv1611]

Well... the pivot table is not really working.. I did get one that they first thought was maybe doable but it's just really not what they want.

For instance, the PT I came up with was similar to what you showed if not the same, but I showed:
Label for rows
Element and Flag for Columns
Then counted another field to get some sort of # in the body.
That would show for Label 12345 (some said "blank" some had actual #s, and a few other variations), looking at the element Ag (silver) and a series of numbers, there were 5 instances where Flag "u" showed up
Then we could double-click on the # of 5 and see all the details for those 5 records.

But with what they're looking at, they say it's still just too much to look at.

So that said, we're each stepping away and thinking about it, and see if they come up with any other bright ideas. I am not sure at this point what else I can offer. The VBA method didn't really work, b/c I can't get a definite unique identifier that's good enough to summarize how it seems they want to summarize it. At least that's the way it seems in my mind so far.

I don't know how to explain it. They want to see a summary but yet it sounds like they say they still want to see the detail. But summary and detail are not one and the same.

They are used to being able to see the detail and have things pop-out at them, but I don't think that's even what they want here or else I could use conditional formatting. Maybe I'll offer that as a suggestion, at least as another possibility. But doesn't sound like it'll work.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[SkipVought]

So is the main summary referent Label or Label and Element or what? What do they want their summary starting point to be in order to minimize the data to select from?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[SkipVought]

This kind of sounds like a poorly stated requirement/statement of work. One of the things I learned as a Business Anslyst, many decades ago, was when given a requirement, usually from my boss or some manager, to find the intended user and start asking clarifying questions and/or restating the requirements as I understood them in order to get either confirmation, clarification or correction.

Questions, questions, questions.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[kjv1611]

Yeah, I do try to force myself to almost punish the requestor/user with questions especially if I do not understand the data well enough. I say it that way, because that's what I feel it comes across with oodles of questions, but I do it anyway.

This is a case where they've never needed to do this in the past, because the laboratory instrument provided software was always "good enough" to get by. It just happened with this machine, their software is missing some important features. The crazy thing is it sounds like the manufacturer KNEW it was a bad idea from what I'm told, but that they literally removed at least one important reporting function/feature from the software.

So this Excel ideal was sort of a last ditch effort to get what they need for looking at thousands of test analysis data on the fly.

Also, it's a brand new device, brand new software, so honestly, everybody is learning. There were a total of 4, maybe 5, total people looking at this from the Lab. One of them specifically is usually pretty good at knowing what all they need to see.

In the end, THANKFULLY, they had a eureka moment late yesterday and came up with a layout that will work for them in Excel, and asked if I could do it. I said DEFINITELY. It was as simple as:

A         B        C                           D              E                                                           F                     G
Label     Type     FIRST DateTime record       Flag           First Element matching the Label and Flag in sequence.      Next Element          So on

So I took some pieces from my original VBA code but mostly rewrote a whole new macro. In my first tests with no real attention to performance or anything, it almost runs instantly at this point. Original data had nearly 15k rows (of course, I know that's not a lot) and I guess 20 columns or so.

I'm glad it runs almost instantly, b/c from the sound of everything I'm told, a fullblown large test could really end up producing I'm guessing a couple hundred thousand rows. So if it performed poorly with 15k rows, there's no way it'd even run with the larger dataset.

The 15k rows became 462 rows of data through this setup. Also, as you might have guessed, the importance of order and Date/Time field was finally mentioned. Even though I had earlier asked "are you sure these are all the fields you all need?" Oh well. I try to always ask about other fields, but perhaps the next time, maybe I'll have a better idea in this environment what might make more sense to keep. DateTime fields are normally important, but from their description, and all communications, it did not seem like a particular order nor datetime value was important.

I should hear sometime early this morning from them whether the output was what they had in mind. If it is, then we'll be finished with this one. I'll share my finished code as well once I am 100% certain it's ready. I'll also add a couple performance and cleanup items before posting.

I've probably rambled too much in this one. Wow.



"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[SkipVought]

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]