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.
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 SubIf you have any questions about the above code please do not hesitate to contact me
Regards
Stephen
