Posts by DBR138

DBR138 · Oct 24th 2018

I over simplified. I am defining a range for my source data an the specific columns I want to keep along with output order. Here is a better representation of the code before I go on to apply an advanced filter criteria:

Code

Dim wb As Workbook, wsSource As Worksheet, wsTarget As Worksheet
Dim columnsToKeep() As Variant, colm As Long, v, Destn As Range, CritRangeTopLeft As Range, CritRangeBottomRight As Range, CritRange As Range
Dim lastColumnSource As Long, lastRowSource As Long, filterRange As Range
[COLOR=#FF0000]Const filterField1 As Long = 8[/COLOR]
[COLOR=#FF0000]Const filterField2 As Long = 27[/COLOR]
Const criterion1 As String = "QC-Completed"
Const criterion2 As String = vbNullString


Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Data")
Set wsTarget = wb.Worksheets("Pass On")
On Error Resume Next: wsSource.ShowAllData: On Error GoTo 0
lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
lastColumnSource = wsSource.Range("A1").SpecialCells(xlCellTypeLastCell).Column
Set filterRange = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastRowSource, lastColumnSource))
[COLOR=#FF0000]columnsToKeep = Array(1, 13, 36, 2, 3, 24, 8, 12) [/COLOR]   'define output columns to keep and their order
'this next section puts the headers on row 1 of the Pass On sheet:
colm = 0
For Each v In columnsToKeep
  colm = colm + 1
  wsTarget.Cells(1, colm).Value = wsSource.Cells(1, v)
Next v


Set Destn = Range(wsTarget.Cells(1, 1), wsTarget.Cells(1, colm))

Display More

So I will need to come up with a way to derive the column numbers used in the red lines above based on the column name in row 1 rather than assuming the columns will always be in the same order.

DBR138 · Oct 23rd 2018

My current macro identifies the columns I want to output and the order in which to do so as follows:

Code

columnsToKeep = Array(1, 13, 36, 2, 3, 24, 8, 12)

I am running into problems because the source data is no longer going to be in the same order consistently. There will always be a heading in row 1 and the values will remain to accurate to the data below so I want to use that value but can't seem to make it work. The result would end up something like:

Code

columnsToKeep = Array(Item, Sequence, Sales Order Priority, Batch Number, Lot No, Firmed, Header/Line Status, Req Compl Date)

I realize that I will end up needing to define these but I am not sure how to put it all together.

Thank you!

DBR138 · Jul 13th 2018

I believe that the problem lies within this smaller section of code. perhaps I need to re define my range after the data is filtered rather than using dataArray again?

Code

With filterRange


         .AutoFilter
        .AutoFilter Field:=filterField1, Criteria1:="<>" & criterion1, Operator:=xlFilterValues
        .AutoFilter Field:=filterField2, Criteria1:=criterion2


                           
With wsSource.AutoFilter.Range
             dataArray = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)  'exclude header
        End With


    End With


    Application.CutCopyMode = False              'Clear clipboard


    Dim columnsToKeep() As Variant
    columnsToKeep = Array(13, 36, 2, 3, 24, 8, 12) 'determine output columns to keep and their order


    Dim currentRow As Long
    Dim currentColumn As Long
    Dim resultArray() As Variant
    ReDim resultArray(1 To UBound(dataArray, 1), 1 To UBound(columnsToKeep) + 1)
    Dim columnCounter As Long


    For currentRow = LBound(dataArray, 1) To UBound(dataArray, 1)


        columnCounter = 0


        For currentColumn = LBound(columnsToKeep) To UBound(columnsToKeep)


            columnCounter = columnCounter + 1
            resultArray(currentRow, columnCounter) = dataArray(currentRow, columnsToKeep(currentColumn))


        Next currentColumn


    Next currentRow


    wsTarget.Range("A2").Resize(UBound(resultArray, 1), UBound(resultArray, 2)) = resultArray

Display More

DBR138 · Jul 13th 2018

I believe that is needed but I spent all night trying to figure out where to put it. I've resorted to haphazardly inserting it and testing it to find the solution but have not been successful.

DBR138 · Jul 13th 2018

The example data is only a partial example but I expect this will fill your need. Let me know if it doesn't.

Code

Sub Delrow()
    Dim N As Long, i As Long
    N = Cells(Rows.Count, "K").End(xlUp).Row 'Count column K to determine range.
    'Using K because it appears to always have a value if the line is used for anything
    For i = N To 1 Step -1 
        If Cells(i, "C") < 1 And Cells(i, "G") < 1 Then
            Cells(i, "C").EntireRow.Delete 
        End If
    Next i
End Sub

DBR138 · Jul 12th 2018

I have the following macro that is intended to filter the data tab based on the two specified criteria and then paste the remaining lines into the report. The filters work properly but it is pasting even the hidden rows into the report and I can't figure out how to get it to only paste the visible lines. I am pasting my code below. Has anyone experienced this issue before or know how I might resolve it?

Code

Public Sub CreatePassOn()




    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Const filterField1 As Long = 8           
    Const filterField2 As Long = 27             
    Const criterion1 As String = "QC-Completed"
    Const criterion2 As String = vbNullString


    Set wb = ThisWorkbook
    Set wsSource = wb.Worksheets("Data")
    Set wsTarget = wb.Worksheets("Pass On")


    Dim lastRowSource As Long
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row


    Dim lastColumnSource As Long
    lastColumnSource = wsSource.Range("A1").SpecialCells(xlCellTypeLastCell).Column


    Dim filterRange As Range
    Set filterRange = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastRowSource, lastColumnSource))


    wsSource.AutoFilterMode = False
    Dim dataArray As Variant


    With filterRange


         .AutoFilter
        .AutoFilter Field:=filterField1, Criteria1:="<>" & criterion1, Operator:=xlFilterValues
        .AutoFilter Field:=filterField2, Criteria1:=criterion2


        With wsSource.AutoFilter.Range


             dataArray = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) 'exclude header


        End With


    End With


    Application.CutCopyMode = False              'Clear clipboard


    Dim columnsToKeep() As Variant
    columnsToKeep = Array(13, 36, 2, 3, 24, 8, 12) 'specify output columns to keep and their order


    Dim currentRow As Long
    Dim currentColumn As Long
    Dim resultArray() As Variant
    ReDim resultArray(1 To UBound(dataArray, 1), 1 To UBound(columnsToKeep) + 1)
    Dim columnCounter As Long


    For currentRow = LBound(dataArray, 1) To UBound(dataArray, 1)


        columnCounter = 0


        For currentColumn = LBound(columnsToKeep) To UBound(columnsToKeep)


            columnCounter = columnCounter + 1
            resultArray(currentRow, columnCounter) = dataArray(currentRow, columnsToKeep(currentColumn))


        Next currentColumn


    Next currentRow


    wsTarget.Range("A2").Resize(UBound(resultArray, 1), UBound(resultArray, 2)) = resultArray


MsgBox "Pass on creation succesful! Please update your comments and print."


End Sub

Display More

DBR138 · Feb 28th 2018

I am trying to automate the creation of a report that I presently make to such a level that I can push it onto the users who are not known for their computer skills. I enjoy macros and VBA but this is a little more ambitious than I have gotten so far. I am attaching a sample file containing the source data and the template it will end up in. What I need to do is for each cell in column C of the Data tab where H is not "QC-Completed" and U is blank the copy S, AD, B, C, E, H, L and paste them into the next unused row on tab Pass On in the order I listed to cut them so S would go to A and AD would go to B and so on.
I am hung up on the multiple conditions and I do have a tendency to over think these things.

Ideally this would fit into the following code that I have already written:

Code

Sub ImportOracleShopFloor()


Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Sheet As Worksheet
Dim PasteStart As Range


Sheets("Data").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Sheets("Pass On").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Sheets("Start").Select
   
Set wb1 = ActiveWorkbook
Set PasteStart = [Data!A1]


FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Report to Parse", _
FileFilter:="Report Files *.xlsx (*.xlsx),")


If FileToOpen = False Then
    MsgBox "No File Specified.", vbExclamation, "ERROR"
    Exit Sub
Else
    Set wb2 = Workbooks.Open(Filename:=FileToOpen)


    For Each Sheet In wb2.Sheets
        With Sheet.UsedRange
            .Copy PasteStart
            Set PasteStart = PasteStart.Offset(.Rows.Count)
        End With
    Next Sheet


End If


    wb2.Close
   
 Sheets("Header  Template").Select
    Rows("1:1").Select
    Selection.Copy
    Sheets("Pass On").Select
    Rows("1:1").Select
    ActiveSheet.Paste
   
   
   
   'New code belongs here
   
   
   
MsgBox "Pass on creation succesful! Please update your comments and submit."
End Sub

Display More

Posts by DBR138

Define Array by based on row 1 value instead of column number

Define Array by based on row 1 value instead of column number

VBA autofilter works then pastes all cells to destination negating it. Please Help!

VBA autofilter works then pastes all cells to destination negating it. Please Help!

Del blank but skip if value is in cell G

VBA autofilter works then pastes all cells to destination negating it. Please Help!

Super Macro multiple conditions