PDA

View Full Version : Find my String in an Array?



Dal1981
12-07-2011, 08:22 AM
Starting to rely a little bit to much on this forums support... but I'm an intermediate user of VB ... anyhoo...

To explain the issue:

I have two worksheets that contain nearly the same data sets. Sheet1's table has a list of unique reports with details covering cells "B:F". Sheet2 then has a live list of these reports whereby a Unique reference is created based on month/year & report number.

I want to have a macro whereby sheet1 data will copy over to sheet2 (on the next available row), checking first that the unique number is not already present in sheet2. (Sheet2 is then rowsource to a listbox for users to interact with the reports ... I appreciate this could be better as an Access back end, but the small scale of data doesn't justify the build time).

I've tried and considered a number of methods, and thought that I had landed it but instead find myself feeling rather :banghead: ...to say the least.

It's important that I don't duplicate reports in the schedule, and as important to make sure the updating of the current list is not recorded over.

I guess the jist of what I need is to find a string within a named range of data, and if its there, react to an IF statement...

Anyhow, here's the code as is .... desperatly in need of tlc ...


Private Sub Cbo_Refresh_Click()
'Runs schedule and updates in Current list
Dim MySch As Worksheet 'sheet1
Dim MyCurr As Worksheet 'sheet2
Dim i As Integer
Dim j As Integer
Dim L As Variant
Dim MyUniq As String 'SeqNo as string to check vs Array
Dim MyUq As Long 'converts string to long = probably dont need
Dim MyLastU As Long 'checks range in schedule (sheet2)
Dim MyLastDest As Long 'finds next free cell in current(sheet1)
Set MySch = ActiveWorkbook.Sheets("Schedule")
Set MyCurr = ActiveWorkbook.Sheets("Current_Rep_List")
MyLastU = MySch.Cells.SpecialCells(xlCellTypeLastCell).Row
MyLastDest = MyCurr.Cells.SpecialCells(xlCellTypeLastCell).Row
MyUniq = MySch.Cells(2, 1).Value
Do While MyUniq <= MyLastU
i = MyUniq
'The next line gives a Run-Time '13' ...type mismatch, its my naive use of 'objects & classes ... I figured using 'i' as variant or long... but no avail...
L = Range("A:A").Find(i, MyCurr.Range("A:A"), xlValues, xlWhole, xlByColumns, xlNext).Column
'If i = Sheets("Current_Rep_List").Range("A:A") Then
MyUniq = MySch.Cells.Offset(1, 0).Value
Else:
MyUq = MyUniq
'The next bit is a shocking piece of code that doesnt work...this 'results in a runt-time '1004: method of range class failed
Sheets("Schedule").Range("B" & MyUq & ":F" & MyUq).Select
With Selection.Copy
MyCurr.Cells("A" & MyLastDest).PasteSpecial
End With
End If
Loop
End Sub

------------------------------
Upsetting stuff eh? I'm pretty sure I'm in the right ball park, but everyone else is here for Rugby and I'm dressed for Baseball. If it helps you good people to see the xl sheets themselves, please let me know!

Thanks all for your time


------------------------
I've uploaded sheet - please note the userform was pretty busy so assume its connected to a Commandbutton on a userform, thanks :)

shrivallabha
12-07-2011, 08:40 AM
It will surely help if you could upload the sample Excel file.

Kenneth Hobs
12-08-2011, 08:16 AM
When you use find, it will either find a range or not. If not, then you get an error if you did not check for that. Instead of setting the column, set the found range and check if it is nothing.


Dim f as Range
set f = Range("A:A").Find(i, MyCurr.Range("A:A"), xlValues, xlWhole, xlByColumns, xlNext)
L = 0
If Not f is Nothing then
L = f.Column
End If

shrivallabha
12-09-2011, 10:17 AM
Somehow, it is still not clear to me.

Test this code on a backup copy (I am not very sure about the range to look in and range size to be copied).

Public Sub CopyUniqueItems7()
Dim rFind As Range, r1 As Range, r2 As Range, r As Range
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("Current_Rep_List")
Set ws2 = Sheets("Schedule")
Set r1 = ws1.Range("A2:A" & ws1.Range("A" & Rows.Count).End(xlUp).Row)
Set r2 = ws2.Range("J2:J" & ws2.Range("J" & Rows.Count).End(xlUp).Row)
For Each r In r1
Set rFind = r2.Find(What:=r.Value, LookIn:=xlValues, lookat:=xlWhole)
If rFind Is Nothing Then
r.Resize(1, 6).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2)
End If
Next r
End Sub

Dal1981
12-12-2011, 03:17 AM
Good morning,

I'm getting Run-Time Error 438' Object doesnt support this property / method.

Does this mean I need to update my Xl07 references? Or have the wrong Libraries in use?

Thanks again for your time...

shrivallabha
12-12-2011, 06:28 AM
Doesn't give any error (but nothing changes either, as I am not sure I am referencing the correct range in correct order:dunno). See attachment.