Announcement

Collapse
No announcement yet.

Reorder Columns Based on Headers

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • #16
    Re: Reorder Columns Based on Headers

    Hello,

    Thank you again for your help.
    Can you help me combine two worksheets per row based on matching cells. The cells to match will always be in column B on sheet_1, and in column A on sheet_2.
    The desired result is on the Combined sheet as on the attached example spreadsheet.

    Thank you beforehand,
    Laurent
    Attached Files

    Comment


    • #17
      Re: Reorder Columns Based on Headers

      I think you may find this approach more helpful - you've expired on the goodwill with me!

      Code:
      Option Explicit
      Dim wsSheet As Worksheet
      Dim Rng As Range, CellRange As Range
      Dim SrchHorse As Long
      Dim Sheet1Time As Long, Sheet1Horse As Long, Sheet1Age As Long, Sheet1Weightpounds As Long, Sheet1Penalty As Long, Sheet1WeightRank As Long, Sheet1DSLR As Long, Sheet1FormString As Long, Sheet1PaceString As Long, Sheet1PaceRating As Long
      Dim Sheet2Horse As Long, Sheet2Age As Long, Sheet2DSLR As Long, Sheet2RunsBefore As Long, Sheet2WonBefore As Long, Sheet2PlcBefore As Long, Sheet2HACareer As Long
      Dim Sheet1LstRw As Long, Sheet1LstCl As Long, Sheet2LstRw As Long, Sheet2LstCl As Long, rw As Long
      Sub xample()
      'Code written by [email protected]
      Set wsSheet = Nothing
      On Error Resume Next
      Set wsSheet = ThisWorkbook.Sheets("Sheet1")
      On Error GoTo 0
      If wsSheet Is Nothing Then
      MsgBox "Sheet1 doesnt exist"
      End If
      Set wsSheet = Nothing
      On Error Resume Next
      Set wsSheet = ThisWorkbook.Sheets("Sheet2")
      On Error GoTo 0
      If wsSheet Is Nothing Then
      MsgBox "Sheet2 doesnt exist"
      End If
      'check if Combined sheet exists, if not create it
      Set wsSheet = Nothing
      On Error Resume Next
      Set wsSheet = ThisWorkbook.Sheets("Combined")
      On Error GoTo 0
      If Not wsSheet Is Nothing Then
      Else
      ThisWorkbook.Sheets.Add.Name = "Combined"
      End If
      If ThisWorkbook.Sheets("Combined").AutoFilterMode Then
      ThisWorkbook.Sheets("Combined").AutoFilterMode = False
      End If
      On Error Resume Next
      ThisWorkbook.Sheets("Combined").ShowAllData
      On Error GoTo 0
      ThisWorkbook.Sheets("Combined").Cells.Clear
      ThisWorkbook.Sheets("Combined").Cells.Delete
      
      'this bit is setting the range
      On Error Resume Next
      Set Rng = Range(ThisWorkbook.Sheets("Sheet1").Cells(2, 2), ThisWorkbook.Sheets("Sheet1").Cells(ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count, 2))
      On Error GoTo 0
      'check that the range is something
      If Rng Is Nothing Then
      MsgBox "There are no boats!"
      Exit Sub
      End If
      
      'now we know everything is what it should be, create the sheet. This stipulates the headers. You can go for fixed ranges, but this will aloow you to individually adjust
      ThisWorkbook.Sheets("Combined").Cells(1, 1) = "Time"
      ThisWorkbook.Sheets("Combined").Cells(1, 2) = "Horse"
      ThisWorkbook.Sheets("Combined").Cells(1, 3) = "Age"
      ThisWorkbook.Sheets("Combined").Cells(1, 4) = "Weight (pounds)"
      ThisWorkbook.Sheets("Combined").Cells(1, 5) = "Penalty"
      ThisWorkbook.Sheets("Combined").Cells(1, 6) = "Weight Rank"
      ThisWorkbook.Sheets("Combined").Cells(1, 7) = "DSLR"
      ThisWorkbook.Sheets("Combined").Cells(1, 8) = "Form String"
      ThisWorkbook.Sheets("Combined").Cells(1, 9) = "Pace String"
      ThisWorkbook.Sheets("Combined").Cells(1, 10) = "Pace Rating"
      ThisWorkbook.Sheets("Combined").Cells(1, 11) = "Horse"
      ThisWorkbook.Sheets("Combined").Cells(1, 12) = "Age "
      ThisWorkbook.Sheets("Combined").Cells(1, 13) = "DSLR"
      ThisWorkbook.Sheets("Combined").Cells(1, 14) = "Runs Before"
      ThisWorkbook.Sheets("Combined").Cells(1, 15) = "Won Before"
      ThisWorkbook.Sheets("Combined").Cells(1, 16) = "Plc Before"
      ThisWorkbook.Sheets("Combined").Cells(1, 17) = "HA Career"
      'these are all the variables
      Sheet1LstRw = ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count
      Sheet1LstCl = ThisWorkbook.Sheets("Sheet1").UsedRange.Columns.Count
      Sheet2LstRw = ThisWorkbook.Sheets("Sheet2").UsedRange.Rows.Count
      Sheet2LstCl = ThisWorkbook.Sheets("Sheet2").UsedRange.Columns.Count
      
      Sheet1Time = 0
      On Error Resume Next
      Sheet1Time = Application.Match("Time", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
      On Error GoTo 0
      If Sheet1Time = "0" Then
      MsgBox "I cannot find Time in the first row on sheet1"
      End
      End If
      Sheet1Horse = 0
      On Error Resume Next
      Sheet1Horse = Application.Match("Horse", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
      On Error GoTo 0
      If Sheet1Horse = "0" Then
      MsgBox "I cannot find Horse in the first row on sheet1"
      End
      End If
      Sheet1Age = 0
      On Error Resume Next
      Sheet1Age = Application.Match("Age", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
      On Error GoTo 0
      If Sheet1Age = "0" Then
      MsgBox "I cannot find Age in the first row on sheet1"
      End
      End If
      Sheet1Weightpounds = 0
      On Error Resume Next
      Sheet1Weightpounds = Application.Match("Weight (pounds)", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
      On Error GoTo 0
      If Sheet1Weightpounds = "0" Then
      MsgBox "I cannot find Age in the first row on sheet1"
      End
      End If
      Sheet1Penalty = 0
      On Error Resume Next
      Sheet1Penalty = Application.Match("Penalty", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
      On Error GoTo 0
      If Sheet1Penalty = "0" Then
      MsgBox "I cannot find Penalty in the first row on sheet1"
      End
      End If
      Sheet1WeightRank = 0
      On Error Resume Next
      Sheet1WeightRank = Application.Match("Weight Rank", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
      On Error GoTo 0
      If Sheet1WeightRank = "0" Then
      MsgBox "I cannot find Age in the first row on sheet1"
      End
      End If
      Sheet1DSLR = 0
      On Error Resume Next
      Sheet1DSLR = Application.Match("DSLR", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
      On Error GoTo 0
      If Sheet1DSLR = "0" Then
      MsgBox "I cannot find DSLR in the first row on sheet1"
      End
      End If
      Sheet1FormString = 0
      On Error Resume Next
      Sheet1FormString = Application.Match("Form String", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
      On Error GoTo 0
      If Sheet1FormString = "0" Then
      MsgBox "I cannot find Form String in the first row on sheet1"
      End
      End If
      Sheet1PaceString = 0
      On Error Resume Next
      Sheet1PaceString = Application.Match("Pace String", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
      On Error GoTo 0
      If Sheet1PaceString = "0" Then
      MsgBox "I cannot find Pace String in the first row on sheet1"
      End
      End If
      Sheet1Weightpounds = 0
      On Error Resume Next
      Sheet1Weightpounds = Application.Match("Weight (pounds)", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
      On Error GoTo 0
      If Sheet1Weightpounds = "0" Then
      MsgBox "I cannot find Weight (pounds) in the first row on sheet1"
      End
      End If
      Sheet1PaceRating = 0
      On Error Resume Next
      Sheet1PaceRating = Application.Match("Pace Rating", Range(ThisWorkbook.Sheets("Sheet1").Cells(1, 1), ThisWorkbook.Sheets("Sheet1").Cells(1, Sheet1LstCl)), 0)
      On Error GoTo 0
      If Sheet1PaceRating = "0" Then
      MsgBox "I cannot find Pace Rating in the first row on sheet1"
      End
      End If
      Sheet2Horse = 0
      On Error Resume Next
      Sheet2Horse = Application.Match("Horse", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
      On Error GoTo 0
      If Sheet2Horse = "0" Then
      MsgBox "I cannot find Horse in the first row on sheet2"
      End
      End If
      Sheet2Age = 0
      On Error Resume Next
      Sheet2Age = Application.Match("Age", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
      On Error GoTo 0
      If Sheet2Age = "0" Then
      MsgBox "I cannot find Age in the first row on sheet2"
      End
      End If
      Sheet2DSLR = 0
      On Error Resume Next
      Sheet2DSLR = Application.Match("DSLR", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
      On Error GoTo 0
      If Sheet2DSLR = "0" Then
      MsgBox "I cannot find DSLR in the first row on sheet2"
      End
      End If
      Sheet2RunsBefore = 0
      On Error Resume Next
      Sheet2RunsBefore = Application.Match("Runs Before", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
      On Error GoTo 0
      If Sheet2RunsBefore = "0" Then
      MsgBox "I cannot find Runs Before in the first row on sheet2"
      End
      End If
      Sheet2PlcBefore = 0
      On Error Resume Next
      Sheet2PlcBefore = Application.Match("Plc Before", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
      On Error GoTo 0
      If Sheet2PlcBefore = "0" Then
      MsgBox "I cannot find Plc Before in the first row on sheet2"
      End
      End If
      Sheet2WonBefore = 0
      On Error Resume Next
      Sheet2WonBefore = Application.Match("Won Before", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
      On Error GoTo 0
      If Sheet2WonBefore = "0" Then
      MsgBox "I cannot find Won Before in the first row on sheet2"
      End
      End If
      Sheet2HACareer = 0
      On Error Resume Next
      Sheet2HACareer = Application.Match("HA Career", Range(ThisWorkbook.Sheets("Sheet2").Cells(1, 1), ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2LstCl)), 0)
      On Error GoTo 0
      If Sheet2HACareer = "0" Then
      MsgBox "I cannot find HA Career in the first row on sheet2"
      End
      End If
      
      'you know everything exists, so now build your report
      'Set the start rw as 2
      rw = 2
      For Each CellRange In Rng
      SrchHorse = 0
      On Error Resume Next
      SrchHorse = Application.Match(ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Horse), Range(ThisWorkbook.Sheets("Sheet2").Cells(1, Sheet2Horse), ThisWorkbook.Sheets("Sheet2").Cells(Sheet2LstRw, Sheet2Horse)), 0)
      On Error GoTo 0
      If SrchHorse = "0" Then
      'it doesn't exist so what should you do
      Else
      'its found
      ThisWorkbook.Sheets("Combined").Cells(rw, 1).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Time).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 2).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Horse).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 3).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Age).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 4).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Weightpounds).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 5).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1Penalty).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 6).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1WeightRank).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 7).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1DSLR).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 8).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1FormString).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 9).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1PaceString).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 10).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet1PaceRating).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 11).Value = ThisWorkbook.Sheets("Sheet2").Cells(CellRange.Row, Sheet2Horse).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 12).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2Age).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 13).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2DSLR).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 14).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2RunsBefore).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 15).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2WonBefore).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 16).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2PlcBefore).Value
      ThisWorkbook.Sheets("Combined").Cells(rw, 17).Value = ThisWorkbook.Sheets("Sheet1").Cells(CellRange.Row, Sheet2HACareer).Value
      'need to offset for the next row
      rw = rw + 1
      End If
      
      'next cell in your range
      Next CellRange
      'tidy the formats
      ThisWorkbook.Sheets("Combined").Columns(1).NumberFormat = "hh:mm:ss"
       
      End Sub

      Comment


      • #18
        Re: Reorder Columns Based on Headers

        Hello,
        Thank you for the code, I didn't mean to be too demanding.
        You could have asked me for a contribution for your time, which I'd always agree to.
        I hope I can still ask you for advice.
        Best regards,
        Laurent

        Comment


        • #19
          Re: Reorder Columns Based on Headers

          Don't worry, it was tongue in cheek!

          Comment


          • #20


            Re: Reorder Columns Based on Headers

            Hi,

            Thank you for the code and the accompanying explanations. I may have missed something (this is my first time attempting to use VBA in excel) but I'm not sure if any of the aforementioned code can address my problem:

            My workbook has a master sheet where the core data (DealSheet) is located (only one column is important here: names of clients). This list of clients is continually growing and most importantly can be manipulated by users, including myself, with a sort function on any of the data columns in the DealSheet and so clients can appear in any, random, order.

            There is another sheet (TaskSheet) in the workbook that displays a static number of tasks for each client (column header beginning in column F) and the level of completion for each task (descending down rows) in the corresponding cells. My goal is to rearrange the columns in the TaskSheet automatically based on whatever client sort takes place on the DealSheet. Additionally, I want the VBA function to be fluid...meaning I don't want to manually add an additional client in "quotes" every time a new client is brought on board and let the function do that work for me.

            Any suggestions would be greatly appreciated! Thanks in advance for the time.

            IM

            Comment

            Working...
            X