Posts by dangle

dangle · Jul 19th 2012

Re: Finding Variables and inserting row below them from a list

Bobd

Give this a try and let me know if it's doing what you want.

Code

Sub Inserter()
Dim a, b(), i As Long, j As Long, k As Long, lRow As Long, x As Long, z(6), zz
Dim sDic As Object, ws As Worksheet
Set sDic = CreateObject("Scripting.Dictionary")
With Sheets("List Sheet")
    a = .Range("A1:J7").Value
End With
For i = 2 To UBound(a, 1)
    For j = 4 To UBound(a, 2)
        z(j - 4) = a(i, j)
    Next
    sDic.Item(a(i, 1)) = z
Next
For Each ws In Worksheets
    x = 0
    If ws.Name <> "List Sheet" Then
        With ws
            lRow = .Range("A" & Rows.Count).End(xlUp).Row
            a = .Range("A3", .Range("G" & lRow))
            ReDim b(1 To UBound(a, 1) * 2, 1 To UBound(a, 2))
            For i = 1 To UBound(a, 1)
                x = x + 1
                For j = 1 To UBound(a, 2)
                    b(x, j) = a(i, j)
                Next
                If sDic.exists(a(i, 1)) Then
                    x = x + 1
                    zz = sDic.Item(a(i, 1))
                    For k = 0 To UBound(zz)
                        b(x, k + 1) = zz(k)
                    Next
                End If
            Next
            With .Range("A3")
                With .Resize(x)
                    With .Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                End With
                With .Resize(x, UBound(b, 2))
                    .Value = b
                    .Borders.LineStyle = xlNone
                    With .Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                    With .Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlThin
                    End With
                    With .Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                    With .Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .ColorIndex = 0
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                End With
            End With
        End With
    End If
Next
Set ws = Nothing
Set sDic = Nothing
End Sub

Display More

dangle · Jul 17th 2012

Re: Creating new sheet and naming it after imported excel file in excel with VBA

Well, OzGrid is always a good start!

http://www.ozgrid.com/VBA/

But keep using (and searching) the forums here and elsewhere, asking questions as you go and practise your own coding, either based on your own projects or scenarios found in the forums.
Often just a web search will bring up lots of help. E.g. 'vba with statement'.

Good luck!

dangle · Jul 17th 2012

Re: Creating new sheet and naming it after imported excel file in excel with VBA

This would create new sheets for all the filenames listed in column C:

Code

Sub Example()
Dim r As Range
For Each r In Range("C8", Range("C" & Rows.Count).End(xlUp))
    If Not IsError(r) Then
        Worksheets.Add(After:=Sheets(Worksheets.Count)).Name = r
    End If
Next
End Sub

However, your code needs some work. For instance:
Dim all your variables at the start of the code
Avoid using Select, Activate and ActiveCell where possible. You can normally work direct with the object, often using the 'with' statement.
E.g.

Code

Sheets("RawData").Select
    Range("G2").Select
    If ActiveCell.Text <> "" Then

Could just be:

Code

if Sheets("RawData").range("G2") <> "" then

Or you could also set up object variables for your workbooks, worksheets and ranges and then refer to these in your code.

dangle · Jul 17th 2012

Re: Creating new sheet and naming it after imported excel file in excel with VBA

Can you upload a sample of your file with your current code?

dangle · Jul 17th 2012

Re: Creating new sheet and naming it after imported excel file in excel with VBA

Hello Erzhena and welcome to the board

For example:

Code

Sub Example()
Dim FileName As String
FileName = "Hello"
Worksheets.Add(After:=Sheets(Worksheets.Count)).Name = FileName
End Sub

dangle · Jul 17th 2012

Re: Generate specific number of worksheets based on cell number.

Hello Singularity and welcome to the board

Try:

Code

Sub CreateSheets()
Dim i As Long
For i = 1 To Sheets("Sheet1").Range("A1") 'Your cell reference for number of days
    Sheets("Sheet2").Copy After:=Sheets(Worksheets.Count)
    ActiveSheet.Name = "Day" & i
Next
End Sub

dangle · Jul 11th 2012

Re: consolidate duplicate listings, merge all info from one column

Maybe something like:

Code

Sub Consolidate()
Dim a, i As Long, j As Long, n As Long
a = Sheets("Sheet1").Range("A1").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(a, 1)
        If Not .exists(a(i, 1)) Then
            n = n + 1
            .Item(a(i, 1)) = n
            For j = 1 To UBound(a, 2) - 2
                a(.Item(a(i, 1)), j) = a(i, j)
            Next
            a(.Item(a(i, 1)), 8) = a(i, 8) & " - " & a(i, 9)
        Else
            a(.Item(a(i, 1)), 8) = a(.Item(a(i, 1)), 8) & ", " & a(i, 8) & " - " & a(i, 9)
        End If
    Next
End With
With Sheets("Sheet2").Range("A1")
    .Resize(, UBound(a, 2) - 1).Value = Sheets("Sheet1").Range("A1:H1").Value
    .Offset(1).Resize(n, UBound(a, 2) - 1).Value = a
End With
End Sub

Display More

dangle · Jun 22nd 2012

Re: index/match item to multiple columns in DV.

No probs. Not sure why that is with the blanks. Not ideal but maybe a combo could overcome that if necessary.

dangle · Jun 22nd 2012

Re: Search for IDs in a column, get specific columns, create 2 new ones and paste

Giannis

It's not clear what you are trying to do.

1)You could just filter these values
2)What do you mean by 'get'?
3)You could just insert 2 columns

Perhaps you could also provide a sample with you desired output.

dangle · Jun 22nd 2012

Re: index/match item to multiple columns in DV.

Maybe:

=OFFSET(INDEX(ITEM,MATCH(F2,ITEM)),,1,,3)

Or use a combo box if it suits.

dangle · Jun 21st 2012

Re: Transposing Excel Data - Repeating Column Headers

Give this a try and see if it works for you:

Code

Sub Trans()
Dim a, b(), i As Long, j As Long, x As Long
a = Range("B3", Cells(6, 3).End(xlToRight))
ReDim b(1 To (UBound(a, 1) - 1) * UBound(a, 2), 1 To 2)
For i = 1 To UBound(a, 2)
    For j = 2 To UBound(a, 1)
        x = x + 1
        b(x, 1) = a(1, i)
        b(x, 2) = a(j, i)
    Next
Next
Range("B10").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Display More

dangle · Jun 21st 2012

Re: Copy specific worksheets values only to a new workbook

There may be slightly better ways of doing this, such as using a 'select case' statement rather than multiple 'if' statements and organising the unhiding/hiding of sheets, maybe use some additional subs, but I am not sure that this is your issue if you are saying it is noticeably slow.
How about:

Code

Application.Calculation = xlCalculationManual
'Your code
Application.Calculation = xlCalculationAutomatic

dangle · Jun 20th 2012

Re: find loop to search value in column A only, on location copy/paste in new locatio

Add this line at the beginning of your code and I think you will see what the problem is:

Code

MsgBox ActiveCell.Address

Try to avoid using ActiveCell if at all possible. It is likely to give you unexpected results.

I have adapted your code:

Code

Sub Cpaste()
Dim fcell As Range, beginningaddress As String
With Sheet1
    Set fcell = .Columns(1).Find("f", LookIn:=xlValues)
        If Not fcell Is Nothing Then
        beginningaddress = fcell.Address
        Do
            fcell.Offset(, 3).Resize(, 7) = Application.Transpose(fcell.Offset(-3).Resize(7))
            Set fcell = .Columns(1).FindNext(fcell)
        Loop While Not fcell Is Nothing And fcell.Address <> beginningaddress
    End If
End With
End Sub

Display More

dangle · Jun 18th 2012

Re: Changing Rows to Columns

This might work based on what you have provided and if each group of data is structured in the same way. But AAE is right, it would be much easier if you provided a sample workbook.

Code

Sub Transposer()
Dim a, b(), i As Long, ii As Long
a = Range("A5", Range("C" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a, 1), 1 To 7)
For i = 0 To UBound(a, 1) Step 8
    For ii = 1 To 7
        b(i / 8 + 1, ii) = a(i + ii, 3)
    Next
Next
With Sheets("Sheet2").Range("A1")
    .Resize(, 7) = Application.Transpose(Range("A5", Range("A5").End(xlDown)))
    .Offset(1).Resize(UBound(b, 1), UBound(b, 2)).Value = b
End With
End Sub

Display More

dangle · Jun 15th 2012

Re: Copy specific worksheets values only to a new workbook

I don't know if this is really what you are looking for and it would help to see a sample file but here is a possible. Note it saves the "Summary" workbook.

Code

Sub runreport()
Dim a, i As Long, wb1 As Workbook, wb2 As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb1 = ThisWorkbook
With wb1
    With Sheets("Menu")
        a = .Range("M3", .Range("M" & Rows.Count).End(xlUp)).Value
    End With
End With
Set wb2 = Workbooks.Add
For i = 1 To UBound(a, 1)
    wb1.Activate
    If SheetExists(Trim(a(i, 1))) Then
        wb1.Worksheets(Trim(a(i, 1))).Visible = True
        With wb2
            wb1.Sheets(Trim(a(i, 1))).Copy Before:=.Sheets(1)
            .Worksheets(Trim(a(i, 1))).UsedRange.Value = .Worksheets(Trim(a(i, 1))).UsedRange.Value
        End With
        wb1.Worksheets(Trim(a(i, 1))).Visible = xlSheetVeryHidden
    End If
Next
With wb2
    .SaveAs wb1.Path & "\Summary"
    .Close
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set wb1 = Nothing
Set wb2 = Nothing
     
End Sub

Display More

dangle · Jun 15th 2012

Re: Macro to move text to columns and output as list populating specific data.

Thanks for the link. Very helpful to see some more examples of RegExp.

dangle · Jun 15th 2012

Re: Maximising use of AutoFilter

Glad you sorted it. I am not quite sure what you mean by the last question. You can do some formatting with a message box. Or maybe use a userform.

dangle · Jun 15th 2012

Re: Macro to move text to columns and output as list populating specific data.

Great work Jindon.

dangle · Jun 14th 2012

Re: Macro to move text to columns and output as list populating specific data.

No problem. Glad to help.

dangle · Jun 14th 2012

Re: Macro to move text to columns and output as list populating specific data.

Hi Chris

Hope this is of use:

Code

Sub CG()
Dim a, b(), i As Long, s, x As Long
a = Range("A1").CurrentRegion.Value
ReDim b(1 To WorksheetFunction.Sum(Range("C2", "C" & UBound(a, 1))) + 1, 1 To 2)
For i = 1 To UBound(a, 1)
    For Each s In Split(a(i, 2), ".")
        x = x + 1
        b(x, 1) = a(i, 1)
        b(x, 2) = s
    Next
Next
Sheets("AFTER").Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Display More