Script that automatically writes

[dangerd]

Hi there,

I have a very specific requirement but poor vba knowledge.

Basically I am looking for a script that will look a all the strings
contained within a range, compare it with data in another range and,
if there is data missing, append the missing data at the end of the
second range.

So it will go a little like this:

1- XL looks at all the data in colum A
2- Data in column A is then compared to that in column B
3- Is there are any difference, missing data is appended to column B

Has anyone got any ideas?

THx

D

 

[Mike H]

Maybe this,

Right click the sheet tab, view code paste this in an run it

Sub stance()
Dim MyRangeA, MyrangeB, BigRange As Range
LastrowA = Cells(Rows.Count, "A").End(xlUp).Row
lastrowb = Cells(Rows.Count, "B").End(xlUp).Row
Set MyRangeA = Range("A1:A" & LastrowA)
Set MyrangeB = Range("B1:B" & lastrowb)
For Each a In MyRangeA
For Each b In MyrangeB
If a.Text = b.Text Then Exit For
If BigRange Is Nothing Then
Set BigRange = a
Else
Set BigRange = Union(BigRange, a)
End If
Next
Next
BigRange.Copy
Cells(lastrowb, 2).Offset(1, 0).PasteSpecial
End Sub

Does that work?
Mike

 

[Rick Rothstein \(MVP - VB\)]

So it will go a little like this:

1- XL looks at all the data in colum A
2- Data in column A is then compared to that in column B
3- Is there are any difference, missing data is appended to column B

Can you explain what you mean by #3 above? What exactly do you consider a
"difference"? The data in Column A is not anywhere in Column B? Or it might
be in Column B, but in a different row? Something else, perhaps?

Rick

 

[dangerd]

Can you explain what you mean by #3 above? What exactly do you consider a
"difference"? The data in Column A is not anywhere in Column B? Or it might
be in Column B, but in a different row? Something else, perhaps?

Rick

Hi Rick,

By difference, I mean if the data is not anywhere to be found in
column B.

I am doing this to analyse my expenses; whenever a new kind of
transaction occurs, I want to be able to categorize it.

Duncs

 

[dangerd]

Maybe this,

Right click the sheet tab, view code paste this in an run it

Sub stance()
Dim MyRangeA, MyrangeB, BigRange As Range
LastrowA = Cells(Rows.Count, "A").End(xlUp).Row
lastrowb = Cells(Rows.Count, "B").End(xlUp).Row
Set MyRangeA = Range("A1:A" & LastrowA)
Set MyrangeB = Range("B1:B" & lastrowb)
    For Each a In MyRangeA
        For Each b In MyrangeB
            If a.Text = b.Text Then Exit For
                If BigRange Is Nothing Then
                    Set BigRange = a
                Else
                    Set BigRange = Union(BigRange, a)
            End If
        Next
Next
BigRange.Copy
Cells(lastrowb, 2).Offset(1, 0).PasteSpecial
End Sub

Does that work?
Mike










- Show quoted text -

Sorry Mike, it doesn't.

It just copies all the entries from column A to the end of column B
regardless of whether they already exist in column B.

D

 

[Rick Rothstein \(MVP - VB\)]

So it will go a little like this:

By difference, I mean if the data is not anywhere to be found in
column B.

In that case, the code Bob posted (corrected by me in a subsequent message)
will do what you want. Here is Bob's corrected code that you can copy/paste
into your own VBA code...

Public Sub ProcessData()
Dim i As Long
Dim iLastRow As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With ActiveSheet
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
If IsError(Application.Match(.Cells(i, "A").Value, _
.Columns(2), 0)) Then
.Cells(.Range("B1").End(xlDown).Offset(1, 0).Row, "B").Value = _
.Cells(i, "A").Value
End If
Next i
End With
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Rick

 

[dangerd]

In that case, the code Bob posted (corrected by me in a subsequent message)
will do what you want. Here is Bob's corrected code that you can copy/paste
into your own VBA code...

Public Sub ProcessData()
  Dim i As Long
  Dim iLastRow As Long
  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
  End With
  With ActiveSheet
    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To iLastRow
      If IsError(Application.Match(.Cells(i, "A").Value, _
                                   .Columns(2), 0)) Then
        .Cells(.Range("B1").End(xlDown).Offset(1, 0).Row, "B").Value = _
                                                .Cells(i, "A").Value
      End If
    Next i
  End With
  With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
  End With
End Sub

Rick

Fantastic! it works! thanks a lot.