Merge/Stack Multiple Named Ranges (Across Multiple Worksheets) in a Master Sheet

[ColinMC]

@SirJB7 or @jeffreyweir

Hello, I am new to the site, but I have already benefited greatly from all of the wisdom.

I have a problem that is only slightly different from the above.

Problem definition
- use a summary slide to compile results from 5 raw data worksheets
- the summary slide should only include 4 columns. (product/date/description/short description)


The constraint I'm trying to work through is the fact that the data is in different columns across the 5 raw data worksheets. (for instance, the date could be in column 1 for product A and column 6 for product B )

I can set the column (please see below) but I have no idea how to add this data to the summary tab..

[Set rngSource = [ProductA].ListColumns(3).Range.Select]

Please let me know if you would like me to post a sample doc't.

Thank you in advance!

 

[Aravindakumar]

Dear friends please verify my below attached file. Sr. No not generated properly. how to solve this problem. Thanking you

 

[Aravindakumar]

>>> use code - tags <<<

Private Sub btnAdd_Click()
Dim I As Long, j As Long
Dim A As Integer
Set rs = Worksheets("RAW")

  'Find the first empty row
  lRow = rs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  rs.Cells(lRow, 1).Value = Me.cmbSurname.Value
  lRow = rs.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
  rs.Cells(lRow, 2).Value = Me.cmbName.Value
  lRow = rs.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
  rs.Cells(lRow, 2).Value = Me.cmbNLM.Value
 

    Dim xRg As Range
    On Error Resume Next
    Worksheets.Add Sheets(1)
     For I = 2 To Sheets.Count
        Set xRg = Sheets(1).UsedRange
        If I > 2 Then
            Set xRg = Sheets(1).Cells(xRg.Rows.Count + 1, 1)
        End If
        Sheets(I).Activate
        ActiveSheet.UsedRange.Copy xRg
    Next
         
  TargetSheet = cmbWard.Value
  If TargetSheet = "" Then
  Exit Sub
  End If
  Worksheets(TargetSheet).Activate
  ActiveSheet.Cells(Lastrow + 1, 1).Value = iSerial
  Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
  ActiveSheet.Cells(Lastrow + 1, 2).Value = Me.cmbWard.Value
  ActiveSheet.Cells(Lastrow + 1, 3).Value = Me.txtBooth.Value
  ActiveSheet.Cells(Lastrow + 1, 4).Value = UCase(txtVSN)
  ActiveSheet.Cells(Lastrow + 1, 5).Value = UCase(Me.txtVLPN)
  ActiveSheet.Cells(Lastrow + 1, 6).Value = StrConv(LTrim(cmbSurname & " " & cmbName.Value), vbUpperCase)
  ActiveSheet.Cells(Lastrow + 1, 7).Value = UCase(Me.txtEPIC)
  ActiveSheet.Cells(Lastrow + 1, 8).Value = UCase(Me.txtDoorno)
  ActiveSheet.Cells(Lastrow + 1, 9).Value = UCase(Me.cmbNLM)
  If Len(txtContact.Value) = 10 Then
  ActiveSheet.Cells(Lastrow + 1, 10).Value = Me.txtContact.Value
  End If
  If Len(txtContact.Value) = 7 Then
  ActiveSheet.Cells(Lastrow + 1, 10).Value = "0891 - " + Me.txtContact.Value
  End If
  ActiveSheet.Cells(Lastrow + 1, 11).Value = UCase(Me.cmbRemarks1.Value)
  ActiveSheet.Cells(Lastrow + 1, 12).Value = UCase(Me.cmbRemarks2.Value)
  With Worksheets(TargetSheet).UsedRange.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
  End With
 
 
 
 
ActiveSheet.Visible = True
ActiveCell.Offset(1, 0).Select
ActiveWorkbook.Save
 
   
 
  'Clear down the values ready for the next record entry...
  Me.cmbSurname.Value = Empty
  Me.cmbName.Value = Empty
  Me.txtBooth.Value = Empty
  Me.txtDoorno.Text = Empty
  Me.cmbNLM.Value = Empty
  Me.txtEPIC.Text = Empty
  Me.txtContact.Text = Empty
  Me.txtVLPN.Value = Empty
  Me.cmbWard.Value = Empty
  Me.txtVSN.Value = Empty
  Me.cmbRemarks1.Value = Empty
  Me.cmbRemarks2.Value = Empty
   
  ActiveSheet.Visible = True
  ActiveCell.Select
  ActiveWorkbook.Save
 
 
  Unload Me
  UserForm.Show
 
End Sub


Private Sub UserForm_Initialize()
'fill cmbWard
Me.cmbWard.AddItem "14"
Me.cmbWard.AddItem "24"
Me.cmbWard.AddItem "25"
Me.cmbWard.AddItem "26"
Me.cmbWard.AddItem "42"
Me.cmbWard.AddItem "43"
Me.cmbWard.AddItem "44"
Me.cmbWard.AddItem "45"
Me.cmbWard.AddItem "46"
Me.cmbWard.AddItem "47"
Me.cmbWard.AddItem "48"
Me.cmbWard.AddItem "49"
Me.cmbWard.AddItem "50"
Me.cmbWard.AddItem "51"
Me.cmbWard.AddItem "53"
Me.cmbWard.AddItem "54"
Me.cmbWard.AddItem "55"

'fill cmbRemark1
Me.cmbRemarks1.AddItem "Available"
Me.cmbRemarks1.AddItem "Not Available"
Me.cmbRemarks1.AddItem "Other"

'fill cmbRemark2
Me.cmbRemarks2.AddItem "New"
Me.cmbRemarks2.AddItem "Shifted"
Me.cmbRemarks2.AddItem "Found"
Me.cmbRemarks2.AddItem "Not Found"
Me.cmbRemarks2.AddItem "Death"

'fill cmbSurname
With RAW
    Me.cmbSurname.List = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    Me.cmbName.List = .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
    Me.cmbNLM.List = .Range("C2:C" & .Range("C" & Rows.Count).End(xlUp).Row).Value
    End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode = VbControlMenu Then

       Cancel = True
       MsgBox "You have to exit using the close button on the form!", vbCritical, "Error"
    End If

End Sub

 

[Aravindakumar]

Please correction at sr. no

 

[vletm]

Aravindakumar​

You have wrote something to about ten years old thread.
This thread is closed now.