VBA

Resolved · Medium Priority · Version 2007

Thu 16 Dec 2010, 16:00 Delegate Soniya said...

Soniya has attended:
Excel VBA Intro Intermediate course

VBA

Question 1
On the course you said we could create a list from another where it just gives a list of every unique entry.

Can you show me how to do this.

Question 2
Please can you copy the VBA document below into word or notepad. It will make it easier to read.

I have taken a copy of part the document, but you said there was some way to make this more efficient. Also could you explain how Print # and Write # work.

START OF VBA DOCUMENT BELOW

Sheets("prices").Select

Range("A14").Select

Dim assrec(150, 10) As String
rec = 0
For c = 1 To 150
rec = rec + 1
If IsEmpty(ActiveCell.Value) Then GoTo outfile:
assrec(c, 1) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
assrec(c, 2) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
assrec(c, 3) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
assrec(c, 4) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
assrec(c, 5) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
assrec(c, 6) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
assrec(c, 7) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
assrec(c, 8) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
assrec(c, 9) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
assrec(c, 10) = ActiveCell.Value

ActiveCell.Offset(1, -9).Select
Next c
outfile:
Open "G:\Settlements\pricesIL.txt" For Output As 1
Print #1, "PROGRAM FMPR"
Print #1, "RECORD"
For h = 1 To 10
Print #1, assrec(1, h)
Next h

Print #1, "ENDRECORD"
Print #1,
For x = 2 To rec - 1

Print #1, "MOD ";
For k = 1 To 10
Write #1, assrec(x, k);
Next k
Print #1,
Next x
Print #1,
Print #1, "END"
Close #1

ActiveWorkbook.Saved = True

Windows("pricesIL.xls").Activate
ActiveWorkbook.Save

Windows.Application.Quit

Save_Exit

End Sub

END OF VBA DOCUMENT

If you need me to send this again, please e-mail me back.

Fri 17 Dec 2010, 11:46 Trainer Stephen said...

RE: VBA

Hi Soniya

Thanks for your question

I have a solution for your first question which is provided in the code below. I will investigate your second question, and reply shortly

Sub SelectUniqueData()



    'The following code moves down a row of data. At each cell it checks to

    'see if the data is already in an array, and if it isn't it adds it to

    'the array

    

    Dim UniqueList() As String

    Dim strCurrentItem As String

    Dim i As Integer

    Dim j As Integer

    Dim k As Integer

    Dim blnExists As Boolean

    

    ReDim UniqueList(1)

    

    blnExists = False

    

    UniqueList(1) = Range("A1").Value

    k = 2

    

    For i = 2 To Range("A1").CurrentRegion.Rows.Count

        blnExists = False

        strCurrentItem = Range("a1").Cells(i, 1)

        For j = 1 To UBound(UniqueList)

            If UniqueList(j) = strCurrentItem Then

                blnExists = True

                Exit For

            End If

        Next j

        If blnExists = False Then

             ReDim Preserve UniqueList(k)

             UniqueList(j) = strCurrentItem

             blnExists = False

             k = k + 1

        End If

    Next i



    For j = 1 To UBound(UniqueList)

        Debug.Print UniqueList(j)

    Next j

    

End Sub