Excel Macro Copy cell range & paste data one sheet to another - vba

I am trying to look up a value given a list and copy the remaining row contents into the columns adjacent to the list. I copied some code from this site and have looked for answers elsewhere can't find anything. Every time I run the code it gives me a compile error "Invalid outside procedure"
Sub test()
Dim LR As Long
Dim i As Long
Dim x As Long
Dim lastDataRow As Long
Dim lastListRow As Long
Dim sheetOne As String
Dim sheetTwo As String
Dim listItem As String
Dim dataItem As String
Dim listColNum As Long
Dim dataColNum As Long
listColNum = 1
dataColNum = 2
sheetOne = "new_copy"
sheetTwo = "Historical_data_"
lastListRow = Sheets(sheetOne).Cells(Sheets(sheetOne).Rows.Count, listColNum).End(xlUp).row
lastDataRow = Sheets(sheetTwo).Cells(Sheets(sheetTwo).Rows.Count, dataColNum).End(xlUp).row
For x = 1 To lastListRow
For i = 1 To lastDataRow
If Sheets(sheetOne).Cells(x, listColNum).Value = Sheets(sheetTwo).Cells(i, dataColNum).Value Then
Sheets(sheetOne).Cells(x, 3).Value = Sheets(sheetTwo).Cells(i, 3).Value
End If
Next i
Next x
End Sub
Any help would be appreciated!

The code that you submitted compiles and runs without an issue.
When you see Invalid outside procedure you typically have code that is not between the Sub and End Sub
The statement must occur within a Sub or Function, or a property
procedure (Property Get, Property Let, Property Set).
Also, you should check that your code is in a Module and not in worksheet or workbook code

Related

Changing value of TextBox due to selection of ComboBox VBA Excel

I have a project in which I have to change to value of a textbox to a value that is searched in a workseet against a vlaue that has been selected from a combobox. for example if I select "A" from the combobox the it should search the worksheet "test" find the input for A and change the text box value to 1 as this is the value entered for A. I have looked at some of the other questions that have been asked here but could not seem to get it to work for me. Below is the code that I have been trying to use.
Private Sub IDComboBox_Change()
Dim domainRange As Range
Dim listRange As Range
Dim selectedString As Variant
Dim lastRow As Long
If IDComboBox.ListIndex <> -1 Then
selectedString = IDComboBox.Value
lastRow = Worksheets("test").Range("A" & Rows.Count).End(xlUp).Row
Set listRange = Worksheets("test").Range("A2:A" & lastRow)
For Each domainRange In listRange
If domainRange.Value = selectedString Then
DomainOwnerTestBox.Value = "test"
End If
Next domainRange
End If
End Sub
Any help would be great. If you need anymore information then please let me know and also please be paient with me as im new to VBA.
Thanks
Try this code. It uses Excel built-in MATCH function to search for value in column A of worksheet 'test'.
Private Sub IDComboBox_Change()
Dim wks As Excel.Worksheet
Dim selectedString As Variant
Dim row As Long
Dim value As Variant
Set wks = Worksheets("test")
If IDComboBox.ListIndex <> -1 Then
selectedString = IDComboBox.value
On Error Resume Next
row = Application.WorksheetFunction.Match(selectedString, wks.Columns(1), 0)
On Error GoTo 0
If row Then
value = wks.Cells(row, 2) '<--- assuming that input values are in column 2.
DomainOwnerTestBox.value = value
Else
'Value not found in the worksheet 'test'
End If
End If
End Sub

.find works for me in one procedure but not another

Hello I have the code below. Essentially, it grabs unique values of a certain range in each worksheet and adds it to a range on the side of the same worksheet.
The .find method is not working for me like it does in another procedure and I would like an explanation why or what I am doing wrong or the difference between the behavior of the code when written differently. make sense?
sub methodtwo()
Dim cell As Range
Dim strDATE As String
Dim datehr As Range
For i = 1 To Sheets.Count - 4
Sheets(i).Activate
Set datehr = Sheets(i).Range("H2", Sheets(i).Range("H2").End(xlDown))
For Each cell In datehr
strDATE = cell.Value
Set cell = Sheets(i).Range("L1:L400").Find(What:=strName)
If cell Is Nothing Then
Sheets(i).Range("L1").End(xlDown).Offset(1, 0).Value = cell
End If
Next cell
Next i
End Sub
below is the code I have written before and a reference for writing the code above. In the code below, the find method works perfectly and adds unique values to the designated range...the code above does not.
Sub methodone()
Dim sh As Worksheet
Dim r As Long
Dim a As Range
Dim al As Range
Dim strName As String
For Each sh In Worksheets
sh.Activate
sh.Range("K1").Activate
Set al = ActiveSheet.Range("A2:A13000")
For Each a In al
strName = a.Value
Set Cell = ActiveSheet.Range("K1:K400").Find(What:=strName)
If Cell Is Nothing Then
ActiveSheet.Range("K1").End(xlDown).Offset(1, 0).Value = a
End If
Next a
Next sh
End Sub
I wanted the methodtwo() to do the exact same thing as methodone() except on the last 4 sheets.
Is the problem obvious? I'm working on my attention to detail..especially when using a previously written code for reference.
for methodone() I just had to change strNAME to strDATE which is a detail error when converting one procedure to the other. I also changed the "cell" after the IF statement to "strDATE"
sub methodtwo()
Dim cell As Range
Dim strDATE As String
Dim datehr As Range
For i = 1 To Sheets.Count - 4
Sheets(i).Activate
Set datehr = Sheets(i).Range("H2", Sheets(i).Range("H2").End(xlDown))
For Each cell In datehr
strDATE = cell.Value
Set cell = Sheets(i).Range("L1:L400").Find(What:=strDATE)
If cell Is Nothing Then
Sheets(i).Range("L1").End(xlDown).Offset(1, 0).Value = strDATE
End If
Next cell
Next i
end sub

Dynamically parsing row cells of excel file in VB using Microsoft.Office.Interops.Excel COM

I've been attempting to feed a variable to a Microsoft.Office.Interop.Excel.Worksheet.Cells call, but its proving to be very finicky.
I do this in a loop, and I'd like to incorporate the rowcount in the cell to parse like so:
Have this:
Dim rng As Excel.Range = CType(worksheet.Cells(1, 1), Excel.Range)
Want This:
Dim rowCount As Integer = 1
Dim rng As Excel.Range = CType(worksheet.Cells(i, 1), Excel.Range)
^^
But I'm getting this exception:
System.NullReferenceException: Object reference not set to an instance of an object.
and stepping through my local variables in the debugger, I get this sad message for rng.Value:
In order to evaluate an indexed property, the property must be qualified and the arguments must be explicitly supplied by the user.
I'm interpreting that to mean that cell range index needs to be set explicitly (like actually putting in ....Cells(1,1) ).
Is what I'm trying to achieve possible? If not, how can I parse this cell dynamically as I loop through the rows of my excel application?
Full Code:
Dim app As New Excel.Application
Dim workbook As Excel.Workbook
Dim worksheet As Excel.Worksheet
Dim rowCount As Integer = 0
Dim range As Excel.Range
workbook = app.Workbooks.Open(specsheetName, [ReadOnly]:=False)
worksheet = workbook.Worksheets("Sheet1")
range = worksheet.UsedRange
updateStatusLabel.Text = range.Rows.Count.ToString() & ", " & range.Columns.Count.ToString()
Dim i As Integer
For i = 1 To range.Rows.Count
Dim msg As String
Dim Obj As Excel.Range = CType(worksheet.Cells(i, 1), Excel.Range) '<--BREAKS HERE!
If Obj.Value.ToString.Contains("Device Prefix") Then
msg = worksheet.Range("B1").Value().ToString()
updateStatusLabel.Text = msg
Return '***** adding this is what did it.
Else
updateStatusLabel.Text = "not found"
End If
rowCount = rowCount + 1
Next
app.Workbooks.Close()
Again, the code runs for assignment .Cells(1,1) but not for .Cells(i,1) (subtle difference)
Thanks in advance!
UPDATE: SOLUTION FOUND
*I was able to add a Return after "updateStatusLabel.Text = msg` (ie after the cell I'm looking to parse is found, and everything worked great. I guess I'm just not used to the VB looping system. I don't understand why that worked. See above code for change.
The Exception that you get let me think your excel workbook isn't correctly loaded.
please try this :
Dim excelApp As Excel.Application = New Excel.Application
excelApp.Visible = False
Dim excelWorkBook As Excel.Workbook = excelApp.Workbooks.Open("C:\\MyPath.xls")
Dim worksheet As Worksheet = excelWorkBook.Worksheets("Sheet1")
Dim rowCount As Integer = 10
For i = 1 To rowCount Step 1
'Get the Excel cells
Dim rng As Excel.Range = worksheet.Cells(i, 1)
Next

Excel VBA Copy Cell Color error

I have a simple function to copy the background color of cells with similar contents in different ranges (one range is failRange the other is toColor)
It fails at the line assigning the Interior.Color and the excel debugger gives me no information at all, it just stops. I have separated out ever variable so I can easily see all values using the debugger and they are all set just fine.
Does anyone see the problem???
Function ColorRange(failRange As Range, toColor As Range)
Dim targetCell As Range
Dim failCell As Range
Dim targetValue As String
Dim failValue As String
Dim colorValue As Long
Dim compareResult As Integer
Dim counter As Integer
For Each targetCell In toColor
targetValue = Left(targetCell.Text, 7)
For Each failCell In failRange
failValue = failCell.Text
compareResult = InStr(failValue, targetValue)
If compareResult > 0 Then
colorValue = failCell.Interior.ColorIndex
rem next line causes failure
targetCell.Interior.ColorIndex = colorValue
counter = counter + 1
Exit For
End If
Next failCell
Next targetCell
ColorRange= counter
End Function
A UDF called from a worksheet cell can only return a value to that cell. It cannot affect any cell's format.
If you want to change formats, use a sub.

Use VBA functions and variables in a spreadsheet

I'm new to Excel VBA. I am trying to use a VBA function I found online that enables the user to use goalseek on multiple cells at a time. How do I call the function in a spreadsheet and how do I point to the cells that are supposed to be associated with the variables in the function (e.g. Taddr, Aaddr, gval). Do I have to write the cell values and ranges in the code itself and just run it that way?
Maybe I should redefine the function so that it takes these variables as input, so I can write a formula like =GSeekA(Taddr,Aaddr,gval)
Option Explicit
Sub GSeekA()
Dim ARange As Range, TRange As Range, Aaddr As String, Taddr As String, NumEq As Long, i As Long, j As Long
Dim TSheet As String, ASheet As String, NumRows As Long, NumCols As Long
Dim GVal As Double, Acell As Range, TCell As Range, Orient As String
' Create the following names in the back-solver worksheet:
' Taddr - Cell with the address of the target range
' Aaddr - Cell with the address of the range to be adjusted
' gval - the "goal" value
' To reference ranges on different sheets also add:
' TSheet - Cell with the sheet name of the target range
' ASheet - Cell with the sheet name of the range to be adjusted
Aaddr = Range("aaddr").Value
Taddr = Range("taddr").Value
On Error GoTo NoSheetNames
ASheet = Range("asheet").Value
TSheet = Range("tsheet").Value
NoSheetNames:
On Error GoTo ExitSub
If ASheet = Empty Or TSheet = Empty Then
Set ARange = Range(Aaddr)
Set TRange = Range(Taddr)
Else
Set ARange = Worksheets(ASheet).Range(Aaddr)
Set TRange = Worksheets(TSheet).Range(Taddr)
End If
NumRows = ARange.Rows.Count
NumCols = ARange.Columns.Count
GVal = Range("gval").Value
For j = 1 To NumCols
For i = 1 To NumRows
TRange.Cells(i, j).GoalSeek Goal:=GVal, ChangingCell:=ARange.Cells(i, j)
Next i
Next j
ExitSub:
End Sub
GSeekA is a Subprocedure, not a Function. Subprocedures cannot be called from worksheet cells like Functions can. And you don't want to convert GSeekA into a function. Functions should be used to return values to the cell(s) from which they're called. They shouldn't (and often can't) change other things on the sheet.
You need to run GSeekA as a sub. Now the problem becomes how you get user provided information into the sub. You can use InputBox to prompt the user to enter one piece of information. If you have too many, InputBox becomes cumbersome.
You can create areas in the spreadsheet where the user must enter information, then read from that area. That's how it's set up now. It's reading cells named asheet and tsheet. As long as those named ranges are present, the code works.
Finally, you can create a UserForm that the user will fill out. That's like putting a bunch of InputBoxes on one form.
Update Here's a simple procedure that you can start with and enhance.
Public Sub GSeekA()
Dim rAdjust As Range
Dim rTarget As Range
Dim dGoal As Double
Dim i As Long
'Set these three lines to what you want
Set rAdjust = Sheet1.Range("I2:I322")
Set rTarget = Sheet1.Range("J2:J322")
dGoal = 12.1
For i = 1 To rAdjust.Count
rTarget.Cells(i).GoalSeek dGoal, rAdjust.Cells(i)
Next i
End Sub