need help finding a way to get a VBA code to get excel to give me an output table for a dataset

Maggie Barr

Board Regular
Joined
Jan 28, 2014
Messages
188
I desperately need help finding a way to get a VBA macro/code to get excel to give me an output table for a dataset. I am working on a PC with excel 2010. I have tried to look into pivot tables, power query, etc. as a way to do this but am not finding anything. I think the best way to do this would be through a VBA macro, but I do not have the skills to write this. Any help advice would be greatly appreciated.
I have columns A through BI. Column A is species name, B is field notes, and C through BI are field locations. I need to have an output of species found in each field location (columns C through BI). If a cell in column C is not blank (say C18), then I need an output of the cell contents to display the site name from C1 with data from A18; C18; B18 in the cell next to it.. As it continues to search for the non-blank cells it would always print C1 in the first column, and then A#; C#; B# with the number equaling the number for the non-blank cell. I hope this is making sense. What this will do is give me a list of the species and relevant information for each site. I have put a sample dataset on boxnet for you to view (https://app.box.com/s/5ovmoguhzwm5zwyst01wh8tlrn5j2942) Below is an example of what I need the output to look like.
For instance for the first two columns C & D the output would look like
CI-1
Achillea millefolium ssp. lanulosa; R
CI-1
Argentina egedii ssp. groenlandica; R; NEED PHOTOS
CI-1
Lathyrus japonicus var. maritimus; U; NEED PHOTOS
CI-1
Ligusticum scoticum ssp. scoticum; R; NEED PHOTOS
CI-1
Lysimachia maritima; R
CI-1
Solidago sempervirens var. sempervirens; R; NEED PHOTOS
CI-2
Achillea millefolium ssp. lanulosa; U
CI-2
Cerastium fontanum ssp. vulgare; U; NEED PHOTOS
CI-2
Lathyrus japonicus var. maritimus; U; NEED PHOTOS
CI-2
Ligusticum scoticum ssp. scoticum; U; NEED PHOTOS
CI-2
Moehringia lateriflora; U
CI-2
Picea glauca; U; NEED PHOTOS
CI-2
Poa pratensis ssp. pratensis; U
CI-2
Rumex acetosella ssp. pyrenaicus; U
CI-2
Solidago sempervirens var. sempervirens; R; NEED PHOTOS
CI-2
Taraxacum officinale; R; NEED PHOTOS
CI-2
Trifolium repens; U; NEED PHOTOS

<tbody>
</tbody>


Thank you in advance for your time and interest in helping me.
Best wishes,
Maggie
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Hello Maggie Barr,

The macro below is run when the button on "Sheet2" is clicked. A copy of the workbook is available Field Site Summary ver 1.xlsm
Code:
Sub Summarize()

    Dim Data    As Variant
    Dim DstRng  As Range
    Dim DstWks  As Worksheet
    Dim Item    As Variant
    Dim NextRow As Long
    Dim RngBeg  As Range
    Dim RngEnd  As Range
    Dim SrcRng  As Range
    Dim SrcWks  As Worksheet
    
        Set SrcWks = Worksheets("Sheet1")
        Set SrcRng = SrcWks.Range("A1").CurrentRegion
        
        Set DstWks = Worksheets("Sheet2")
        Set DstRng = DstWks.Range("A2:B2")
        
        DstWks.UsedRange.Offset(1, 0).Clear
        
        Application.ScreenUpdating = False
        
            For C = 3 To SrcRng.Columns.Count
                For R = 2 To SrcRng.Rows.Count
                    If Not IsEmpty(SrcRng.Cells(R, C)) Then
                        With DstRng.Offset(NextRow, 0)
                            .Cells(1, 1).Value = SrcRng.Cells(1, C).Value
                                Data = SrcRng.Cells(R, "A").Value & ";" & SrcRng.Cells(R, C).Value
                                If SrcRng.Cells(R, "B") <> "" Then Data = Data & ";" & SrcRng.Cells(R, "B").Value
                            .Cells(1, 2).Value = Data
                            NextRow = NextRow + 1
                        End With
                    End If
                Next R
            Next C
            
        Application.ScreenUpdating = True
        
End Sub
 
Upvote 0
Leith,
TRULY AMAZING, Thank you so much for this. I also greatly appreciate the comment inserts within the macro so that as I read through I can try to understand what it is that was done, this very helpful for people like me who really want to understand and learn from the assistance we get. I have been reading through the macro and, unfortunately, most if it is a foreign language to me, but I will spend some considerable time reading through it to try to understand it non the less. I just cant thank you enough!
Best wishes,
Maggie
 
Upvote 0
Hello Maggie Barr,

You're welcome and thanks for the feedback. Here is the fully annotated macro so you can better understand what is happening. If you have any questions, please ask.
Code:
Sub Summarize()

    Dim Data    As Variant      ' Information to copy and paste
    Dim DstRng  As Range        ' Destination Range
    Dim DstWks  As Worksheet    ' Worksheet where the Destination Range is located
    Dim NextRow As Long         ' Next empty row on the Destination worksheet
    Dim SrcRng  As Range        ' The Source Range whose data will be copied
    Dim SrcWks  As Worksheet    ' Worksheet where the Source Range is located
    
      ' Assign the Source Worksheet and Source Range.
        Set SrcWks = Worksheets("Sheet1")
        
      ' The Current Region is a rectangular range defined by blank rows
      ' and columns around the cells. Worksheet edges are the same as blanks.
        Set SrcRng = SrcWks.Range("A1").CurrentRegion
        
      ' Assign the Destinatoin worksheet name and Destination range.
        Set DstWks = Worksheets("Sheet2")
        
      ' This is the first row where Destination Data will be pasted..
        Set DstRng = DstWks.Range("A2:B2")
        
      ' The UsedRange of a worksheet includes cells with values or formatting.
      ' The first row contains headers. Delete everything from row 2 down.
        DstWks.UsedRange.Offset(1, 0).Clear
        
      ' Don't update the Destination Worksheet until all rows have been updated.
        Application.ScreenUpdating = False
        
          ' Start with column "C" (3) to last used column of the Source Range.
            For C = 3 To SrcRng.Columns.Count
            
              ' Start with row 2 of the Source Range to the last row of the Source Range.
                For R = 2 To SrcRng.Rows.Count
                
                  ' Check if the Source Range cell has data.
                    If Not IsEmpty(SrcRng.Cells(R, C)) Then
                    
                      ' Yes. Copy the needed data from the Source Range to the next empty row of the Destination Range.
                        With DstRng.Offset(NextRow, 0)
                        
                          ' Copy the header from row 1 of the Source Worksheet column c to cell "A" of the Destination Range.
                            .Cells(1, 1).Value = SrcRng.Cells(1, C).Value
                            
                              ' Build a text string using the species and field location
                                Data = SrcRng.Cells(R, "A").Value & ";" & SrcRng.Cells(R, C).Value
                                
                              ' Add field notes to the text string if there are any.
                                If SrcRng.Cells(R, "B") <> "" Then Data = Data & ";" & SrcRng.Cells(R, "B").Value
                                
                           ' Copy the text to cell "B" of the Destination Range.
                            .Cells(1, 2).Value = Data
                            
                          ' Increment the row offset counter. This will now point to the next empty row on the Destination sheet.
                            NextRow = NextRow + 1
                        End With
                        
                    End If
                    
              ' Go to the next row in the Source Range
                Next R
                
          ' Go to the next column in the Source Range
            Next C
            
      ' Update the Destination worksheet and display it.
        Application.ScreenUpdating = True
        
End Sub
 
Upvote 0
Leith,
WOW! This was super helpful! This was great for me to understand the settings. I will have many islands with worksheets of different lengths etc. and will need these outputs regularly as we revisit the islands to collect more data and give regular updates. As well, with the descriptions like this it may provide me the ability to use pieces of it or modify it for other needs where I have large data sets that need to be reconfigured etc. Thanks so very much for the extra time you put in to write out the explanations. I am always so amazed and grateful for all the help I get.
Sincerely,
Maggie
 
Upvote 0
Hello Maggie,

You're welcome. Glad I could help you with your project. Sounds exciting.

Sonas is àgh ort!
(Success and good fortune be with you!)
 
Upvote 0

Forum statistics

Threads
1,214,918
Messages
6,122,257
Members
449,075
Latest member
staticfluids

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