Posts by Krishnakumar

    Re: Copy sheet and rename from a list, ignore duplicates


    I don't think you need a dictionary here.


    an alternative


    [vb]Sub CreateSheetsFromAList() ' Example Add Worksheets with Unique Names

    Dim MyRange As Range, i As Long
    Dim ShtName As String

    Application.ScreenUpdating = 0
    With Sheets("Schedule")
    Set MyRange = .Range("A11:A" & .Range("a" & .Rows.Count).End(xlUp).Row)
    End With

    Sheets("Template").Visible = True

    With MyRange
    For i = 1 To .Rows.Count
    ShtName = Trim(.Cells(i, 1).Value)
    If Len(ShtName) Then
    If Not WorksheetExists(ShtName) Then
    Sheets("Template").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = ShtName
    End If
    End If
    Next
    End With

    Sheets("Template").Visible = False
    Application.ScreenUpdating = 1

    End Sub[/vb]

    Re: Opening outlook mail


    Hi Welcome to board!!!


    Please use code tag while posting codes in forum.


    Have you got any error ? If so, you need to open the Outlook first before running the macro.

    Re: Select unique items and sort in combo boxes


    [vb]Function SortArray(ByVal Ary As Variant, Optional Asc As Boolean = True)

    Dim i As Long
    Dim j As Long
    Dim Tmp

    If Asc Then
    For i = LBound(Ary) To UBound(Ary)
    For j = i To UBound(Ary)
    If IsNumeric(Ary(j)) Or IsDate(Ary(j)) Then
    If Ary(i) > Ary(j) Then
    Tmp = Ary(i)
    Ary(i) = Ary(j)
    Ary(j) = Tmp
    End If
    ElseIf LCase$(Ary(i)) > LCase$(Ary(j)) Then
    Tmp = Ary(i)
    Ary(i) = Ary(j)
    Ary(j) = Tmp
    End If
    Next
    Next
    Else
    For i = LBound(Ary) To UBound(Ary)
    For j = i To UBound(Ary)
    If IsNumeric(Ary(j)) Or IsDate(Ary(j)) Then
    If Ary(i) < Ary(j) Then
    Tmp = Ary(i)
    Ary(i) = Ary(j)
    Ary(j) = Tmp
    End If
    ElseIf LCase$(Ary(i)) < LCase$(Ary(j)) Then
    Tmp = Ary(i)
    Ary(i) = Ary(j)
    Ary(j) = Tmp
    End If
    Next
    Next
    End If

    SortArray = Ary

    End Function[/vb]

    Re: Select unique items and sort in combo boxes


    [vb]Function SortArray(ByVal Ary As Variant, Optional Asc As Boolean = True)

    Dim i As Long
    Dim j As Long
    Dim Tmp

    If Asc Then
    For i = LBound(Ary) To UBound(Ary)
    For j = i To UBound(Ary)
    If LCase$(Ary(i)) > LCase$(Ary(j)) Then
    Tmp = Ary(i)
    Ary(i) = Ary(j)
    Ary(j) = Tmp
    End If
    Next
    Next
    Else
    For i = LBound(Ary) To UBound(Ary)
    For j = i To UBound(Ary)
    If LCase$(Ary(i)) < LCase$(Ary(j)) Then
    Tmp = Ary(i)
    Ary(i) = Ary(j)
    Ary(j) = Tmp
    End If
    Next
    Next
    End If

    SortArray = Ary

    End Function[/vb]


    and use like


    [vb] Dim v, e, k

    With ws.Range("shipname")
    v = .Value
    End With
    With CreateObject("scripting.dictionary")
    .comparemode = 1
    For Each e In v
    If Not .exists(e) Then .Add e, Nothing
    Next
    If .Count Then
    k = .keys
    Me.ComboBox1.List = SortArray(k)
    End If
    End With[/vb]

    Re: QC/Debug/Compatibility Worksheet E-mailer - $50


    Hi


    I tested this on Office versions 2010,13 and 16 on Win 10 64 bit.


    The error is not generating now, but on the other hand the only solution I could find, to avoid the picture as a blank shape, is pausing the macro for 2 seconds in between the loop. I tried everything like using the DoEvents, emptying the clipboard etc. but none of those gives a permanent fix. By pausing the macro seems working on my limited test on all versions.


    Let me know how it goes for you.


    PFA.


    PS: I'm ready to return your money if my solution doesn't work for you.

    Re: Insert some specific data from multiple txt files into one excel sheet.


    replace the Do.. While part with the following..


    [vb]Do While Len(fn)
    kk = Split(CreateObject("scripting.filesystemobject").opentextfile(Fldr & fn).readall, vbLf)
    n = n + 1
    For i = 0 To UBound(kk)
    For j = 0 To UBound(s)
    If InStr(1, kk(i), s(j), 1) Then
    If j > 3 Then
    k(n, j + 1) = Replace(Split(kk(i), ",")(0), "¦", "")
    GoTo 1
    Else
    k(n, j + 1) = kk(i)
    End If
    Exit For
    End If
    Next
    Next
    1:
    i = UBound(kk)
    k(n, UBound(s) + 2) = Replace(Split(IIf(Len(kk(i)), kk(i), kk(i - 1)), ",")(0), "¦", "")
    fn = Dir()
    Loop[/vb]

    Re: Insert some specific data from multiple txt files into one excel sheet.


    Replace


    [vb]s = Array("Product code", "Batch code", "Recipe nr.", "Weight:", "Start time", "End time")[/vb]


    with


    [vb]s = Array("Product code", "Batch code", "Recipe nr.", "Weight:", "¦")[/vb]


    and add this line before fn = Dir()


    [vb]k(n, UBound(s) + 2) = Replace(Split(IIf(Len(kk(i - 1)), kk(i - 1), kk(i - 2)), ",")(0), "¦", "")[/vb]

    Re: Insert some specific data from multiple txt files into one excel sheet.


    Hi Lopina


    Welcome to OzGrid!!!


    give this a try.


    Note: Please change the text file path in the code.


    In a standard module


    [vb]Option Explicit


    Sub kTest()

    Dim kk, k(), i As Long, fn As String, n As Long
    Dim Fldr As String, s, j As Long, wks As Worksheet

    Fldr = "C:\Test" '<<< adjust this text file path

    If Not Right(Fldr, 1) = Application.PathSeparator Then Fldr = Fldr & Application.PathSeparator

    fn = Dir(Fldr & "*.txt")
    s = Array("Product code", "Batch code", "Recipe nr.", "Weight:", "Start time", "End time")

    ReDim k(1 To 1000, 1 To 6)

    Do While Len(fn)
    kk = Split(CreateObject("scripting.filesystemobject").opentextfile(Fldr & fn).readall, vbLf)
    n = n + 1
    For i = 0 To UBound(kk)
    For j = 0 To UBound(s)
    If InStr(1, kk(i), s(j), 1) Then
    If j > 3 Then
    k(n, j + 1) = Replace(Split(kk(i), ",")(0), "¦", "")
    Else
    k(n, j + 1) = kk(i)
    End If
    Exit For
    End If
    Next
    Next
    fn = Dir()
    Loop

    If n Then
    On Error Resume Next
    Set wks = Worksheets("Output_")
    Err.Clear: On Error GoTo 0
    If wks Is Nothing Then
    Set wks = Worksheets.Add
    wks.Name = "Output_"
    End If
    With wks
    .UsedRange.Clear
    .[a1:f1] = [{"Product code","Batch code","Recipe nr.","Weight","Start time","End time"}]
    .[a2].Resize(n, UBound(k, 2)).Value = k
    .UsedRange.Columns.AutoFit
    End With
    End If

    End Sub[/vb]