Posts by Krishnakumar

    Re: Dependant drop down in user form


    You don't need multiple Select cases. Try


    [vb]Private Sub cboEmp_Change()
    Dim index As Integer
    Dim rngEmp As Range
    Dim rngType As Range
    Dim ws As Worksheet
    Set ws = Worksheets("ListData")
    index = cboType.ListIndex


    Select Case index
    Case Is = 0
    With cboType
    .Clear
    For Each rngType In ws.Range("TypeList")
    Me.cboType.AddItem rngEmp.Value
    Next rngType
    End With

    Case Is = 1
    With cboType
    .Clear
    For Each rngType In ws.Range("Type2List")
    Me.cboType.AddItem rngType.Value
    Next rngType
    End With
    End Select

    End Sub[/vb]

    Re: Multiple Macros under One Button


    Hi


    If you read Kj's post again, he has explicitly said, put the code in a standard module. Your code is in Worksheet module. Remove the code from sheet module and put it in standard module.

    Re: USD $20 Need to Amend Macro that Populates Sheet with Selected Data


    And if you want to use your own code, here it is... (no row addition needed)


    [vb]Sub Labels_2a()

    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim r As Integer
    Dim c As Integer
    Dim p As Integer
    Dim r1 As Integer
    Dim r2 As Integer
    Dim r3 As Integer
    Dim r4 As Integer
    Dim i As Integer
    Dim c1 As Integer

    Dim w, j As Long

    'Set sh1 = Sheets("LabelData")
    Set sh2 = Sheets("LabelTemplate (2)")
    'sh2.Cells.MergeCells = False

    w = Array("LabelData", "LabelData2", "LabelData3")

    sh2.Cells.ClearContents

    r = 0
    c = 1
    p = 1

    For j = 0 To UBound(w)
    Set sh1 = Worksheets(CStr(w(j)))
    For i = 4 To 51
    If UCase(sh1.Cells(i, 16)) = "Y" Then
    r = r + 1
    If r > 4 Then
    r = 1
    c = c + 1
    End If
    If c > 2 Then
    p = p + 1
    r = 1
    c = 1
    End If
    If r = 1 Then r1 = 3 + (53 * (p - 1))
    If r = 2 Then r1 = 6 + 9 + (53 * (p - 1))
    If r = 3 Then r1 = 8 + 18 + (53 * (p - 1))
    If r = 4 Then r1 = 11 + 27 + (53 * (p - 1))
    If r = 5 Then r1 = 14 + 36 + (53 * (p - 1))
    If r = 6 Then r1 = 17 + 45 + (53 * (p - 1))
    If r = 7 Then r1 = 20 + 54 + (53 * (p - 1))
    If r = 8 Then r1 = 23 + 63 + (53 * (p - 1))
    If c = 1 Then c1 = 3
    If c = 2 Then c1 = 20
    sh2.Cells(r1 + 1, c1) = sh1.Cells(i, 7)
    sh2.Cells(r1 + 1, c1 + 10) = sh1.Cells(i, 9)
    sh2.Cells(r1 + 2, c1) = sh1.Cells(i, 8)
    sh2.Cells(r1 + 3, c1) = sh1.Cells(i, 10)
    sh2.Cells(r1 + 4, c1 + 1) = sh1.Cells(i, 11)
    sh2.Cells(r1 + 4, c1 + 11) = sh1.Cells(i, 12)
    sh2.Cells(r1 + 5, c1 + 7) = sh1.Cells(i, 13)
    sh2.Cells(r1 + 5, c1 + 11) = sh1.Cells(i, 14)
    End If
    Next i
    Next

    'Stop
    'sh2.PrintOut
    sh2.Select
    Cells(1, 1).Select


    End Sub[/vb]

    Re: USD $20 Need to Amend Macro that Populates Sheet with Selected Data


    Quote from Craigside;791566

    I am now testing in my main business SS. Please can you remove the extra row you added, as I think it is throwing out my labels. I think I have a couple of other snags but it will be easier once it clears the the template and focusses after running...


    many thanks


    Hi Rob,
    As I added the rows between those labels, you can delete one row from the beginning of each page and this is a one time activity. I can't attach the final workbook now as I'm at work.


    Please find the revised code.


    [vb]Option Explicit


    Sub PrintLabels()

    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim d As Variant 'label data from each sheet
    Dim k() As Variant 'output array
    Dim c As Long 'left/right label. c=1 left, c=2 right
    Dim w As Variant 'worksheet names array
    Dim b As Long 'starting column adjustment
    Dim q As Long 'vertical label count

    w = Array("LabelData", "LabelData2", "LabelData3") '<<< sheet names

    ReDim k(1 To 311, 1 To 32) '<<< output array [B4:AG314]
    c = 1
    For j = LBound(w) To UBound(w)
    With Worksheets(CStr(w(j)))
    d = .Range("g4", .Cells(.Rows.Count, "p").End(3)).Value
    End With
    If IsArray(d) Then
    For i = 1 To UBound(d, 1)
    If LCase(d(i, 10)) = "y" Then
    If n = 0 And c = 1 Then
    n = n + 1: q = q + 1: b = 1
    Else
    If c = 1 Then
    b = 1: n = n + 12: q = q + 1
    Else
    b = 18
    End If
    End If
    k(n, b + 1) = d(i, 1): k(n, b + 11) = d(i, 3)
    k(n + 1, b + 1) = d(i, 2): k(n + 2, b + 1) = d(i, 4)
    k(n + 3, b + 2) = d(i, 5): k(n + 3, b + 12) = d(i, 6)
    k(n + 4, b + 8) = d(i, 7): k(n + 4, b + 12) = d(i, 8)
    If c = 1 Then c = c + 1 Else: c = 1
    If q Mod 4 = 0 And b = 18 Then n = n + 5
    End If
    Next
    End If
    Next

    If n Then
    With Worksheets("LabelTemplate")
    .UsedRange.ClearContents 'clears everything
    '.Range("b4").Resize(UBound(k, 1), UBound(k, 2)).ClearContents
    .Range("b4").Resize(UBound(k, 1), UBound(k, 2)).Value = k
    On Error Resume Next
    Application.Goto .Cells(1) 'focus to LabelTemplatesheet
    End With
    End If

    End Sub[/vb]

    Re: USD $20 Need to Amend Macro that Populates Sheet with Selected Data


    Okay.
    slight adjustment. Use this code.


    [vb]Option Explicit


    Sub PrintLabels()

    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim d As Variant 'label data from each sheet
    Dim k() As Variant 'output array
    Dim c As Long 'left/right label. c=1 left, c=2 right
    Dim w As Variant 'worksheet names array
    Dim b As Long 'starting column adjustment
    Dim q As Long 'vertical label count

    w = Array("LabelData", "LabelData2", "LabelData3") '<<< sheet names

    ReDim k(1 To 311, 1 To 32) '<<< output array [B4:AG314]
    c = 1
    For j = LBound(w) To UBound(w)
    With Worksheets(CStr(w(j)))
    d = .Range("g4", .Cells(.Rows.Count, "p").End(3)).Value
    End With
    If IsArray(d) Then
    For i = 1 To UBound(d, 1)
    If LCase(d(i, 10)) = "y" Then

    If n = 0 And c = 1 Then
    n = n + 1: q = q + 1: b = 1
    Else
    If c = 1 Then
    b = 1: n = n + 12: q = q + 1
    Else
    b = 18
    End If
    End If
    k(n, b + 1) = d(i, 1): k(n, b + 11) = d(i, 3)
    k(n + 1, b + 1) = d(i, 2): k(n + 2, b + 1) = d(i, 4)
    k(n + 3, b + 2) = d(i, 5): k(n + 3, b + 12) = d(i, 6)
    k(n + 4, b + 8) = d(i, 7): k(n + 4, b + 12) = d(i, 8)
    If c = 1 Then c = c + 1 Else: c = 1
    If q Mod 4 = 0 And b = 18 Then n = n + 6
    End If
    Next
    End If
    Next

    If n Then
    With Worksheets("LabelTemplate")
    .Range("b4").Resize(UBound(k, 1), UBound(k, 2)).ClearContents
    .Range("b4").Resize(UBound(k, 1), UBound(k, 2)).Value = k
    End With
    End If

    End Sub[/vb]

    Re: Copy paste data from one dynamic column to another


    Try something like


    [vb]Option Explicit

    Sub kTest()

    Dim PasteCol As Range
    Dim CopyCol As Range
    Dim LCol As Long
    Dim LRow As Long
    Dim r As Long

    With ActiveSheet
    Set PasteCol = Nothing
    Set PasteCol = .UsedRange.Rows(1).Find("Trade Date", lookat:=1) '<<header
    If Not PasteCol Is Nothing Then
    LCol = .Cells(.UsedRange.Row, .Columns.Count).End(xlToLeft).Column
    LRow = .Cells(.Rows.Count, PasteCol.Column).End(xlUp).Row
    Set CopyCol = .Range(.Cells(.UsedRange.Row + 1, LCol + 1), .Cells(LRow, LCol + 1))

    For r = 1 To CopyCol.Rows.Count Step 2
    If Len(CopyCol.Cells(r, 1).Value) Then
    PasteCol.Cells(r + 1, 1).Value = CopyCol.Cells(r, 1).Value
    End If
    Next
    End If
    End With

    End Sub[/vb]