populate column of filtered worksheet A with data found in workshe

  • Thread starter Automation2ThaRescue
  • Start date
A

Automation2ThaRescue

I have two workbooks. Workbook A has been filtered. I have stored in two
arrays two visibile columns.

Dim serverpos As Variant
Dim ieddesc As Variant
dim lastpoint as Integer

lastpoint = Cells(Cells.Rows.Count, "C").End(xlUp).Row

serverpos = Range(Cells(2, 3), Cells(lastpoint, 3)).SpecialCells(xlVisible)

ieddesc = Range(Cells(2, 5), Cells(lastpoint, 5)).SpecialCells(xlVisible)

First I noticed using the watch on the serverpos variant that
there is
serverpos(1) .. thru serverpos(x) .... but each variant also has a sub
double variant which contains the value. Why vba put the value under the
double variant?
serverpos(1,1) .... serverpos(x,1)

That's really not a problem I don't think, but it may be taking up extra
space than needed, and understaing why it did that would be helpful.

Next with workbook B active, filtered, and sorted, I would like to search
the visible range for serverpos(x) in coulmn(I). When I find the match I want
to copy data from two cells on that row (rows 1 & 2) named (ptdesc,ptname)
into the row on workbook A, which corresponds to the row that the value I am
using to serach for is in.

For j = 1 To lastpoint

Set rng = Range("I:I").Find(serverpos(j, 1), LookAt:=xlPart)

Source.Worksheets("analog").Cells(rng.Row, 2).Copy
After:=Dest.Worksheets("Analogs").Cells(j + 1, 1)

Source.Worksheets("analog").Cells(rng.Row, 1).Copy
After:=Dest.Worksheets("Analogs").Cells(j + 1, 1)

End If

Next j

I noticed that when I set my variants I can chose row,value,cells which sets
up the array and gives me the values in the range. I can also select
address, which does not give me an array but a single value which is equall
to a range of address.

I was thinking of creating a multi dimensional array that contains my two
initialized arrays from Workbook A and two arrays containing (ptdesc,ptname),
values corresponding from the match.

Really at first I was thinking that when I setup my serverpos variant in
workbook A that I could have somehow also stored the row for each value, so
that when I found the match I could just dereference the row from the
serverpos and use it to place the cells in workbook B into workbook A in the
known columns of the corresponding serverpos(x). If there is a way to do
that I would appreciate finding that out as well.

I next thought that if I could get the offset to first visible row in
workbook A which is where my first row is located I could perhaps use it in
getting the data from workbook B into the apporpriate cells of workbbok A.
Is that possible.

I am trying to find the best solution, can you please help :)
 
A

Automation2ThaRescue

I figured out one way is to use offsets.Ex
-----------------------------------------------
MasterDBFileName = Dir(MasterDBpath & "*.xls", vbNormal)
RTUDBFileName = Dir(RTUDBpath & "*.xls", vbNormal)


concatchar = Mid(MasterDBFileName, 1, InStr(1, MasterDBFileName, ".") - 1) &
"1.xls"



Set Source = Workbooks.Open(MasterDBpath & MasterDBFileName)
Set Dest = Workbooks.Open(RTUDBpath & RTUDBFileName)

With Source.Worksheets("analog").Activate



Columns("I:I").Select
Range("A1:AN1000").Sort Key1:=Range("H2"), Order1:=xlAscending, Key2:= _
Range("I2"), Order2:=xlAscending, Key3:=Range("K2"), Order3:=xlAscending _
, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortTextAsNumbers, DataOption2:= _
xlSortTextAsNumbers, DataOption3:=xlSortTextAsNumbers

Columns("H:H").Select
Selection.AutoFilter Field:=1, Criteria1:="<>", Operator:=xlAnd

With Source.Worksheets("analog")
Set Telem_RTU = .AutoFilter.Range.Offset(1,
0).Resize(.AutoFilter.Range.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible)

Set Telem_A = Telem_RTU.Offset(0, 1)
Set ptdesc_rng = Telem_RTU.Offset(0, -6)
Set ptname_rng = Telem_RTU.Offset(0, -7)


End With
End With



With Dest.Worksheets("Analogs").Activate
' remove Analog rows from point list
Columns("E:E").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>*Local RTU*", Operator:=xlAnd

With Dest.Worksheets("Analogs")
Set ieddesc_rng = .AutoFilter.Range.Offset(1,
0).Resize(.AutoFilter.Range.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible)
Set serverpos_rng = ieddesc_rng.Offset(0, -2)
End With

For Each cell In serverpos_rng


If InStr(cell.Offset(0, 2), "PLCC") <> 1 Then
Set rng = Telem_A.Find(cell.Value, LookAt:=xlPart)


'If (Left(rng.Offset(0, -7).Value, InStr(rng.Offset(0, -7).Value, " ") - 1)
= Left(cell.Offset(0, 2).Value, InStr(cell.Offset(0, 2).Value, " ") - 1)) Then
pointsmatch = False
If InStr(cell.Offset(0, 2).Value, "-") Then
If InStr(UCase(rng.Offset(0, -7).Value), UCase(Left(cell.Offset(0, 2).Value,
InStr(cell.Offset(0, 2).Value, "-") - 1))) Then
pointsmatch = True
End If
ElseIf InStr(cell.Offset(0, 2).Value, " ") Then
If InStr(UCase(rng.Offset(0, -7).Value), UCase(Left(cell.Offset(0, 2).Value,
InStr(cell.Offset(0, 2).Value, " ") - 1))) Then
pointsmatch = True
End If
End If

' if we are on PLC device
Else
Set rng = Telem_A.Find(cell.Offset(0, 3).Value, LookAt:=xlPart)
If (rng.Offset(0, -5).Value = "TEST") _
And InStr(UCase(rng.Offset(0, -7).Value), UCase(Left(cell.Offset(0,
2).Value, _
InStr(cell.Offset(0, 2).Value, " ") - 1))) Then
pointsmatch = True
End If
End If

If pointsmatch Then
cell.Offset(0, -1).Value = rng.Offset(0, -7).Value
cell.Offset(0, -2).Value = rng.Offset(0, -8).Value
End If

Next cell

End With

End Sub


NOT ALL the way done yet. Stil waiting for answers to the questions posted
below.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top