Posts by aamarb

great, many thanks for all your help

Quote from CephasOz

Yes, it would.

Code

' Collate the data from the secondary sheets into the Master sheet
Sub CollateData()
    Const cstrTitle As String = "CollateData"
    Const cdblHeaderRow As Double = 1
    '
    Dim strErrMsg As String
    Dim varWorksheets As Variant
    Dim intWksIndex As Integer
    Dim vbmStyle As VbMsgBoxStyle
    Dim wksSub As Worksheet
    Dim wksMaster As Worksheet
    Dim dblSubColIndex As Double
    Dim dblMasterColIndex As Double
    Dim dblNoOfSubRows As Double
    Dim dblNoOfMasterRows As Double
    Dim dblNoOfSubCols As Double
    Dim dblNoOfMasterCols As Double
    '
    On Error GoTo Err_Exit
    '
    With ThisWorkbook
        varWorksheets = Array(.Worksheets("Sheet2"), .Worksheets("Sheet4"), .Worksheets("Sheet5"), .Worksheets("Sheet6"), .Worksheets("Sheet8"))
        Set wksMaster = .Worksheets("Master")
    End With
    '
    dblNoOfMasterCols = wksMaster.Cells(1, 1).CurrentRegion.Columns.CountLarge
    For intWksIndex = LBound(varWorksheets) To UBound(varWorksheets)
        Set wksSub = varWorksheets(intWksIndex)
        dblNoOfSubRows = wksSub.Cells(1, 1).CurrentRegion.Rows.CountLarge
        dblNoOfSubCols = wksSub.Cells(1, 1).CurrentRegion.Columns.CountLarge
        dblNoOfMasterRows = wksMaster.Cells(1, 1).CurrentRegion.Rows.CountLarge
        For dblSubColIndex = 1 To dblNoOfSubCols
            For dblMasterColIndex = 1 To dblNoOfMasterCols
                If (wksSub.Cells(cdblHeaderRow, dblSubColIndex).Value = wksMaster.Cells(cdblHeaderRow, dblMasterColIndex).Value) Then
                    wksSub.Range(wksSub.Cells(cdblHeaderRow + 1, dblSubColIndex), wksSub.Cells(dblNoOfSubRows, dblSubColIndex)).Copy _
                        Destination:=wksMaster.Cells(dblNoOfMasterRows + 1, dblMasterColIndex)
                    wksMaster.Range(wksMaster.Cells(dblNoOfMasterRows + 1, dblNoOfMasterCols + 1), wksMaster.Cells(dblNoOfMasterRows + dblNoOfSubRows - 1, dblNoOfMasterCols + 1)).Value = wksSub.Name
                    Exit For
                End If
            Next
        Next
    Next
    '
Housekeeping:
    Set wksSub = Nothing
    Set wksMaster = Nothing
    Exit Sub
Err_Exit:
    strErrMsg = Err.Number & ": " & Err.Description
    Err.Clear
    vbmStyle = vbCritical + vbOKOnly
    MsgBox strErrMsg, vbmStyle, cstrTitle
    Resume Housekeeping
End Sub

Display More

Thanks mate one last thing, I need it to paste values only

Quote from CephasOz

Does this answer your problem?

Code

' Collate the data from the secondary sheets into the Master sheet
Function CollateData() As Boolean
    Const cstrTitle As String = "CollateData"
    Const cdblHeaderRow As Double = 1
    '
    Dim strErrMsg As String
    Dim varWorksheets As Variant
    Dim intWksIndex As Integer
    Dim vbmStyle As VbMsgBoxStyle
    Dim wksSub As Worksheet
    Dim wksMaster As Worksheet
    Dim intSubColIndex As Integer
    Dim intMasterColIndex As Integer
    Dim dblNoOfSubRows As Double
    Dim dblNoOfMasterRows As Double
    Dim dblNoOfSubCols As Double
    Dim dblNoOfMasterCols As Double
    '
    CollateData = False
    On Error GoTo Err_Exit
    '
    With ThisWorkbook
        varWorksheets = Array(.Worksheets("Sheet2"), .Worksheets("Sheet4"), .Worksheets("Sheet5"), .Worksheets("Sheet6"), .Worksheets("Sheet8"))
        Set wksMaster = .Worksheets("Master")
    End With
    '
    dblNoOfMasterCols = wksMaster.Cells(1, 1).CurrentRegion.Columns.CountLarge
    For intWksIndex = LBound(varWorksheets) To UBound(varWorksheets)
        Set wksSub = varWorksheets(intWksIndex)
        dblNoOfSubRows = wksSub.Cells(1, 1).CurrentRegion.Rows.CountLarge
        dblNoOfSubCols = wksSub.Cells(1, 1).CurrentRegion.Columns.CountLarge
        dblNoOfMasterRows = wksMaster.Cells(1, 1).CurrentRegion.Rows.CountLarge
        For intSubColIndex = 1 To dblNoOfSubCols
            For intMasterColIndex = 1 To dblNoOfMasterCols
                If (wksSub.Cells(cdblHeaderRow, intSubColIndex).Value = wksMaster.Cells(cdblHeaderRow, intMasterColIndex).Value) Then
                    wksSub.Range(wksSub.Cells(cdblHeaderRow + 1, intSubColIndex), wksSub.Cells(dblNoOfSubRows, intSubColIndex)).Copy _
                        Destination:=wksMaster.Cells(dblNoOfMasterRows + 1, intMasterColIndex)
                    Exit For
                End If
            Next
        Next
    Next
    '
    CollateData = True
Housekeeping:
    Set wksSub = Nothing
    Set wksMaster = Nothing
    Exit Function
Err_Exit:
    strErrMsg = Err.Number & ": " & Err.Description
    Err.Clear
    vbmStyle = vbCritical + vbOKOnly
    MsgBox strErrMsg, vbmStyle, cstrTitle
    Resume Housekeeping
End Function

Display More

also would it be possible to add the sheet name in the last column. Many thanks

That worked perfectly, Thanks. would it be possible to only paste values instead of formatting and formulas.

Quote from CephasOz

Does this answer your problem?

Code

' Collate the data from the secondary sheets into the Master sheet
Function CollateData() As Boolean
    Const cstrTitle As String = "CollateData"
    Const cdblHeaderRow As Double = 1
    '
    Dim strErrMsg As String
    Dim varWorksheets As Variant
    Dim intWksIndex As Integer
    Dim vbmStyle As VbMsgBoxStyle
    Dim wksSub As Worksheet
    Dim wksMaster As Worksheet
    Dim intSubColIndex As Integer
    Dim intMasterColIndex As Integer
    Dim dblNoOfSubRows As Double
    Dim dblNoOfMasterRows As Double
    Dim dblNoOfSubCols As Double
    Dim dblNoOfMasterCols As Double
    '
    CollateData = False
    On Error GoTo Err_Exit
    '
    With ThisWorkbook
        varWorksheets = Array(.Worksheets("Sheet2"), .Worksheets("Sheet4"), .Worksheets("Sheet5"), .Worksheets("Sheet6"), .Worksheets("Sheet8"))
        Set wksMaster = .Worksheets("Master")
    End With
    '
    dblNoOfMasterCols = wksMaster.Cells(1, 1).CurrentRegion.Columns.CountLarge
    For intWksIndex = LBound(varWorksheets) To UBound(varWorksheets)
        Set wksSub = varWorksheets(intWksIndex)
        dblNoOfSubRows = wksSub.Cells(1, 1).CurrentRegion.Rows.CountLarge
        dblNoOfSubCols = wksSub.Cells(1, 1).CurrentRegion.Columns.CountLarge
        dblNoOfMasterRows = wksMaster.Cells(1, 1).CurrentRegion.Rows.CountLarge
        For intSubColIndex = 1 To dblNoOfSubCols
            For intMasterColIndex = 1 To dblNoOfMasterCols
                If (wksSub.Cells(cdblHeaderRow, intSubColIndex).Value = wksMaster.Cells(cdblHeaderRow, intMasterColIndex).Value) Then
                    wksSub.Range(wksSub.Cells(cdblHeaderRow + 1, intSubColIndex), wksSub.Cells(dblNoOfSubRows, intSubColIndex)).Copy _
                        Destination:=wksMaster.Cells(dblNoOfMasterRows + 1, intMasterColIndex)
                    Exit For
                End If
            Next
        Next
    Next
    '
    CollateData = True
Housekeeping:
    Set wksSub = Nothing
    Set wksMaster = Nothing
    Exit Function
Err_Exit:
    strErrMsg = Err.Number & ": " & Err.Description
    Err.Clear
    vbmStyle = vbCritical + vbOKOnly
    MsgBox strErrMsg, vbmStyle, cstrTitle
    Resume Housekeeping
End Function

Display More

Sorry to be a total noob, but how would i call/run the function?

Quote from royUK

I think that the best way would be to use AdvancedFilter with some VBA to automate it.

I'm busy at the moment but I'll try to post some code after lunch

ok, thanks

the columns are in different orders because of the where the data is sourced from. I've attached a sample spreadsheet

I have a spreadsheet that contains 30 sheets. I want to copy data form 5 of these sheets (sheet2, sheet4, sheet5, sheet6, sheet8 and they all contain named tables and the table names are the same as the sheet names) to the master data sheet. All these sheets have the same column headers as the master data sheet, but are in a different order/column ref.

a sample of column headers are as below

Many Thanks in advance.

also posted on https://www.mrexcel.com/board/…ers.1124100/#post-5427091

Apologies I wasn’t aware of the cross posting rules. Solution has been found on excel forums, many thanks for all your help

Also posted on

https://www.excelforum.com/exc…ws-and-re-order-data.html

https://www.mrexcel.com/forum/….html?t=1107797&p=5333649

Hi Guys,

I receive a list of items pertaining a customer. I want to do is check if list A has an item from list B then create list C. The problem I’m having is that list A is all in one cell separated by a carriage return. So for example cell A3 has xxx xxy xxz, and can be up to 40 items. I want to compare it to list B which is on sheet 2 column A and if it is in list B show all matching items in cell C3, comma separated or carriage separated.

Many thanks in advance

Hi Guys,

I currently have a macro that copies a single row of raw data from the clipboard into the PasteSpecial sheet, the Email Extract sheet then reorders/formats the data and then copies the reordered data into the DataChecker sheet.

The number of rows in the raw data has increased exponentially, is there any way the current macro could be modified so multiple rows can be done at once. please see the code below:

Sub DATM()
'
' DATM Macro
'
' Keyboard Shortcut: Ctrl+d
'
Range("A2").Select
ActiveSheet.PasteSpecial
Sheets("Email Extract").Select
Range("Table1").Select
Selection.Copy
Sheets("Data Checker").Select
Cells(Range("A1000000").End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Paste MailTable").Select
Range("A4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Record updated"
End Sub

Many thanks in advance.

Re: Only copy updated rows in workbook after refreshing sql query

Thank you very much, that seems to be working.

Hi,

I have a multiple tables on multiple sheets that are upadated through a sql query. I then search these sheets for cretain text and copy these rows to a spearate sheet called other tickets using a vba macro.

Sub OtherTickets()
'ActiveSheet.Unprotect
Dim r As Range, c As Range, j As Integer
Dim lngRowPutTo As Long
With Worksheets("OtherTickets")
    lngRowPutTo = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
For j = 1 To Worksheets.Count
  If Not Worksheets(j).Name = "OtherTickets" Then
    With Worksheets(j)
      Set r = .Range(.Range("H2"), .Range("H2").End(xlDown))
      For Each c In r
        If c = "Other Issue" Then
          Worksheets("OtherTickets").Range("A" & lngRowPutTo & ":V" & lngRowPutTo).Value = .Range(.Cells(c.Row, "A"), .Cells(c.Row, "V")).Value
          lngRowPutTo = lngRowPutTo + 1
        End If
        If c = "Other Request" Then
          Worksheets("OtherTickets").Range("A" & lngRowPutTo & ":V" & lngRowPutTo).Value = .Range(.Cells(c.Row, "A"), .Cells(c.Row, "V")).Value
          lngRowPutTo = lngRowPutTo + 1
        End If
      Next c
    End With
  End If
Next j
'ActiveSheet.Protect
End Sub

What I would like to do now is for the macro to only append new data to the OtherTickets sheet. All the tables have the same column headers and data in column A1 is unique and is incrementing.

Is there any way I call change the macro to look a the last row on OtherTickets and only copy the data from the other sheets if the value in column A is greater than the value in OtherTickets sheet.

Re: Macro to create workbook with custom filename+date

I've attached a sample workbook, and the xlms containg the macro that I've already created. Sorry to have confused you with what I'm trying to do I'll try to elxplain it abit better for you. At the moment a carton is scanned in (Barcode) and then an item is scanned in (Barcode2) if they match the information is shown on screen, If they dont match an error message appears on the screen. What I would like is a new workbook created called exceptions plus today's date, If the worksheet does not exist create column headers Catron Barcode, Item Barcode, Item Description, Comments. If the worksheet does exist enter the two barcodes on the next available row. One of the columns needs to be the time of the exception and if possible the person logged onto the computer.

Hi guys,

I was wondering if you could help.

I've created a macro (with lots of help from guys on this forum :yourock:) I need help on importing exceptions onto a new worksheet titled Exceptions and todays date. The exceptions are two string values which do not match.

If the worksheet does not exist create column headers Catron Barcode, Item Barcode, Item Description, Comments. If it does exist enter the exceptions on the next available row. One of the columns needs to be the time of the exception and if possible the person logged onto the computer.

Many Thanks,

Aamar

Re: Scan barcode and display contents of row

One last thing.... is there anyway that the inputbox could appear in the center on the screen same as the message boxes. Thanks

Re: Scan barcode and display contents of row

Thanks very much thats brilliant.

Re: Scan barcode and display contents of row

ignore the last coment, thank you for your help. If I could ask for one more thing. Could a write some extra code if item is not found. Much appreciated.

Re: Scan barcode and display contents of row

ok, the problem was the data was not on sheet 1, I've changed that know but beacuse there is 45000 items to search through it takes a very long time.