My goal is to make a code that takes in the percent error from sheet 1 (column F) and then if the percent error if below 0.5% it takes the values from columns A:D that correspond with column f (for example if F6 had a percent error below 0.5% the program would copy A6:D6) and copies the cells and pastes them into sheet 2. Then this program needs to loop through all the values in column f and repeat this process.
I have had success with copying and pasting the cells I need using the code below without the If statement. However, I cannot seems to get a code that depends on the percent error.
'The start of the command button
Private Sub CommandButton1_Click()
Dim i As Long
Dim ii As Long
Dim i3 As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim Myrange As Range
Dim PerecntError As Integer
Set wb = ThisWorkbook
Set sht1 = wb.Sheets("RawData")
Set sht2 = wb.Sheets("FilteredData")
'Find the last row (in column A) with data.
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
ii = 2
i = 3
'This is the beginning of the loop
For i = 1 To LastRow
If sht1.Range("F" & ii < 0.5) Then
'First activity
sht2.Range("A" & ii) = sht1.Range("A" & i).Value
sht2.Range("B" & ii) = sht1.Range("B" & i).Value
sht2.Range("C" & ii) = sht1.Range("C" & i).Value
sht2.Range("D" & ii) = sht1.Range("D" & i).Value
ii = ii + 1
i = i + 1
End If
Next
End Sub
The error I am getting is that "Type mismatch"
for this line: "If sht1.Range("F" & ii < 0.5) Then"
Any help would be greatly appreciated.
If sht1.Range("F" & ii < 0.5) Then
should be
If sht1.Range("F" & ii) < 0.5 Then
Related
Wondering if it's possible to use a second workbook as a table to grab matching data similar to a vlookup without using the formula.
Example:
Workbook 1 I want to fill in Column R (Port Code) by looking at Column S (Port City) by using Workbook 2 which has a list of Cities in column D and the Port code I want to fill in workbook 1 in column A.
I know I could use a Vlookup but trying to avoid doing that if I can.
I was thinking of something like this but this only appears to look at the first line of the second worksheet. Any help or push in the right direction would be appreciated.
Dim lr As Long, lr1 As Long, i As Long
Dim LineMaster As Workbook
Dim ls As Worksheet
Dim di As Workbook
Dim td As Worksheet
Set td = di.Worksheets(1)
Set ls = LineMaster.Worksheets(1)
lr = ls.Range("I" & ls.Rows.Count).End(xlUp).Row
For i = 2 To lr
If ls.Range("S" & i).Value Like "" Then
ls.Range("R" & i).Value = ""
ElseIf ls.Range("N" & i).Value = Left(td.Range("D" & i).Value, 4) Then
ls.Range("N" & i).Value = td.Range("A" & i).Value
Else
End If
Next i
Not sure I completely understood your request, but I think you want to do a partial search. In this case, the Instr might be helpful.
I don't think using two workbooks is useful but let's do it your way. Here's what I would go with:
Sub PartialSearch()
Dim lr As Long, lr1 As Long, i As Long, j As Long
Dim lr2 As Long
Dim LineMaster As Workbook
Dim ls As Worksheet
Dim di As Workbook
Dim td As Worksheet
Set LineMaster = ThisWorkbook 'Workbook to fill
Set ls = LineMaster.Worksheets(1) 'Worksheet to fill
Set di = Workbooks.Open(your_workbook) 'Indicate the path of the workbook
Set td = di.Worksheets(1)
lr = ls.Range("S" & ls.Rows.Count).End(xlUp).Row 'Last row of the column S (where cities are already mentioned)
lr2 = td.Range("D" & di.Rows.Count).End(xlUp).Row
For i = 2 To lr
For j = 2 To lr2
If ls.Range("R" & i).Value = "" Then 'If the cell in column R is empty
If InStr(1, ls.Range("S" & i).Value, td.Range("D" & j).Value) > 0 Then 'Then the macro looks for a partial search in the other workbook
ls.Range("R" & i).Value = td.Range("A" & j).Value 'If the value is found, then the port code is written (change the column A if needed)
End If
End If
Next j
Next i
End Sub
Depending on the size of your workbook, this approach might not be the most effective. If it's too time consuming, you could go with .Find.
I have an error which prevents me to run properly my macro. When I try to run my macro, I have the error message runtime error 1004 application defined or object defined error
I checked my code, the error comes from this part of my code: Range("K1") = "= SUM(" & thirdRow & "B:B" & LastRow & ")"
It seems that the part “B:B” of this line is not properly recognized in my code. In fact, I would like my macro to return in cell K1 the value of the sum of my third cell in column B to my last cell in column B; in this case, 587,29 (please see screenshot enclosed I circled it in red).
Many thanks in advance.
Xavi
Sub jfdjdgfjg()
Dim i as Long, counter As Long
Dim thirdcell As Range
Dim r As Range
Set r = ActiveCell
Dim LastRow As Long
Dim thirdRow As Long
LastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Range("B1").Activate
For i = 2 To LastRow 'assuming a header row not to be counted
If r.Rows(i).EntireRow.Hidden = False Then counter = counter + 1
If counter = 2 Then
Set thirdcell = r.Cells(i, "A")
Exit For
End If
Next i
Debug.Print thirdcell
Debug.Print LastRow
thirdRow = thirdcell.Row
Debug.Print thirdRow
Range("K1") = "= SUM(" & thirdRow & "B:B" & LastRow & ")"
End Sub
Intended Result
If a row in a table contains any of the listed strings in column L on Sheet1, Then copy the entire row from Sheet1 and paste the row into a duplicate table on Sheet2 (which would be blank at the beginning).
(UNINTERESTED, UNRELATED, UNDECIDED, etc...)
Then delete the entire row that was transferred from sheet 1.
After macro runs, the new transfers should not reset table on Sheet2, rather add rows on the pre-existing lines. This document would be utilized over months.
Variables
Sheet1 is named Pipeline_Input
Sheet2 is named Closed_Sheet
Sheet1 table is named tblData
Sheet2 table is named tblClosed
Images
Image 1 is the code with error
Image 2 is Sheet 1 with some picture explanation
Image 3 is Sheet 2 with some picture explanation
Current Result
Run-time error '1004':
Application-defined or object-defined error
Sub closedsheet()
Application.ScreenUpdating = False
Dim Pipeline_input As Worksheet 'where is the data copied from
Dim Closed_Sheet As Worksheet 'where is the data pasted to
Dim strPhase() As String
Dim i As Integer
Dim intPhaseMax As Integer
Dim lngLstRow As Long
Dim rngCell As Range
Dim finalrow As Integer
Dim lr As Long 'row counter
Dim Looper As Integer
intPhaseMax = 6
ReDim strPhase(1 To intPhaseMax)
strPhase(1) = "LOST"
strPhase(2) = "BAD"
strPhase(3) = "UNINTERESTED"
strPhase(4) = "UNRELATED"
strPhase(5) = "UNDECIDED"
strPhase(6) = "BUDGET"
'set variables
Set Pipeline_input = Sheet1
Set Closed_Sheet = Sheet2
lr = Range("A" & Rows.Count).End(xlUp).Row
For Looper = LBound(strPhase) To UBound(strPhase)
For i = lr To 6 Step -1
Next
If Not Sheet1.Range("L9:L300" & lngLstRow).Find(strPhase(Looper), lookat:=xlWhole) Is Nothing Then
Range(Cells(i, 1), Cells(i, 20)).Copy
Sheet2.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
Range(Cells(i, 1), Cells(i, 20)).Delete
End If
Next
Sheet2.Select
Sheet2.columns.AutoFit
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Okay, there were a plethora of issues with the code you posted, but I decided to help you out here - Notice a few things - There's no copying and pasting here - we're just transferring data.
Secondly, use easy to understand variables. lr and lngLastRow can't be distinguished from one another, so classify them by which worksheet you're getting that value from.
We create an array in one fell swoop here - Just declare a variant and place our values in. ARRAYS (TYPICALLY) START AT ZERO, NOT ONE, so our loop starts at 0 :). Again, this is what's known as best practice...
I swapped out Looper for j. Again, keep. it. simple!
EDIT: I tested this code out on a simulated workbook and it worked fine - should run into no issues for you either.
EDIT2: Also, always use Option Explicit!
Option Explicit
Sub closedsheet()
Application.ScreenUpdating = False
Dim Pipeline_Input As Worksheet 'source sheet
Dim Closed_Sheet As Worksheet 'destination sheet
Dim i As Long, j As Long, CSlastrow As Long, PIlastrow As Long
Dim strPhase As Variant
'Here we create our array
strPhase = Array("LOST", "BAD", "UNINTERESTED", "UNRELATED", "UNDECIDED", "BUDGET")
'Assign worksheets
Set Pipeline_Input = ActiveWorkbook.Worksheets("Pipeline_Input")
Set Closed_Sheet = ActiveWorkbook.Worksheets("Closed_Sheet")
PIlastrow = Pipeline_Input.Range("A" & Rows.Count).End(xlUp).Row
For j = 0 To UBound(strPhase)
For i = PIlastrow To 6 Step -1
If Pipeline_Input.Range("L" & i).Value = strPhase(j) Then
'Refresh lastrow value
CSlastrow = Closed_Sheet.Range("A" & Rows.Count).End(xlUp).Row
'Transfer data
Closed_Sheet.Range("A" & CSlastrow + 1 & ":S" & CSlastrow + 1).Value = _
Pipeline_Input.Range("A" & i & ":S" & i).Value
'Delete the line
Pipeline_Input.Range("A" & i & ":S" & i).EntireRow.Delete
End If
Next i
Next j
Closed_Sheet.Select
Closed_Sheet.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
I have a text string that is using the ^ symbol as a delimiter.
I need to separate the text into new rows rather than new columns.
I need to create new rows to not overwrite the next line of data below it.
Is this possible without using a macro? I'm not against using one, I just wouldn't know where to start to write it.
Below is a pic of some sample data. The top part is how it's listed, and the bottom (in yellow) is how I would like it.
Using Excel 2010 on Windows 7 Pro.
Thanks to those that responded. A friend was able to help by providing the following code:
Sub Breakout()
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(xlUp).Row
For r = LR To 2 Step -1
Set MyCell = Cells(r, 1)
Arry = Split(MyCell.Value, "^")
For c = 0 To UBound(Arry)
If c > 0 Then MyCell.Offset(c, 0).EntireRow.Insert
MyCell.Offset(c, 0) = Arry(c)
Next c
Next r
End Sub
Could try something like this:
Sub reArrange()
Dim inFirstRng As Range
Dim inRng As Range
Dim inCur As Variant
Dim outFirstRng As Range
Dim outCurRng As Range
Dim ws As Worksheet
'CHANGE ARGUMENT TO YOUR SHEET NAME
Set ws = Worksheets("Sheet2")
With ws
'CHANGE ARGUMENT TO WHATEVER THE FIRST CELL OR YOUR DATA INPUT IS IN COLUMN A
Set inFirstRng = .Range("A3")
Set inRng = .Range(inFirstRng, inFirstRng.End(xlDown))
'CHANGE ARGUMENT TO WHATEVER THE FIRST CELL OR YOUR DATA OUTPUT IS IN COLUMN A
Set outFirstRng = .Range("A9")
Set outCurRng = outFirstRng
End With
For Each cell In inRng.Cells
inCur = WorksheetFunction.Transpose(Split(cell.Value, "^"))
outCurRng.Resize(UBound(inCur), 1).Value = inCur
With ws
.Range("G" & outCurRng.Row & ":L" & outCurRng.Row).Value = _
.Range("G" & cell.Row & ":L" & cell.Row).Value
End With
Set outCurRng = outCurRng.Offset(UBound(inCur), 0)
Next cell
ws.Range("F" & outFirstRng.Row & ":F" & outCurRng.Row - 1).Value = 1
End Sub
i wanted to map columns from one worksheet to another and this is the code i have tried:
Dim x As Integer
x = 2
Do Until Sheets("Sheet1").Range("A" & x).Value = ""
Sheets("Sheet2").Range("C" & x).Value = Sheets("Sheet1").Range("A" & x).Value
x = x + 1
Loop
x = 2
Do Until Sheets("Sheet1").Range("B" & x).Value = ""
Sheets("Sheet2").Range("A" & x).Value = Sheets("Sheet1").Range("B" & x).Value
x = x + 1
Loop
x = 2
Do Until Sheets("Sheet1").Range("C" & x).Value = ""
Sheets("Sheet2").Range("B" & x).Value = Sheets("Sheet1").Range("C" & x).Value
x = x + 1
Loop
in worksheet1 i have:
A B C
1 applicationname applicationid number
2 applcation1 1 123
3 applcation2 2 454
4 applcation3 3 897
in worksheet2 i got:
A B C
1 appid num appname
2 1 123 applcation1
3 2 454 applcation2
4 3 897 applcation3
the problem is there are many other columns and this code seems to be lengthy..i need to loop so that applicationid maps to appid and so on ..i want to know wether there is a way to map columns based on the headers(the data in first row) and can anyone please say what to do if i want to copy the empty cells also?
may i know wether i can have an worksheet like interface say sheet3 where i can fill the required mappings like
A B
1 Application Name App Name
2 Application ID AppID
3 Technology Tech
4 Business Criticality Bus Criticality
5 IT Owner IT Owner
6 Business Owner BusOwner and accordingly map them?thanks in advance
Try this:
Sub Map()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim HeadersOne() As String
Dim HeadersTwo() As String
With ThisWorkbook
Set Sh1 = .Sheets("Sheet1") 'Modify as necessary.
Set Sh2 = .Sheets("Sheet2") 'Modify as necessary.
End With
HeadersOne() = Split("applicationname,applicationid,number", ",")
HeadersTwo() = Split("appname,appid,num", ",")
For HeaderIter = 1 To 3
SCol = GetColMatched(Sh1, HeadersOne(HeaderIter - 1))
TCol = GetColMatched(Sh2, HeadersTwo(HeaderIter - 1))
LRow = GetLastRowMatched(Sh1, HeadersOne(HeaderIter - 1))
For Iter = 2 To LRow
Sh2.Cells(Iter, TCol).Value = Sh1.Cells(Iter, SCol).Value
Next Iter
Next HeaderIter
End Sub
Function GetLastRowMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetLastRowMatched = Sh.Cells(Rows.Count, ColIndex).End(xlUp).Row
End Function
Function GetColMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetColMatched = ColIndex
End Function
Let us know if this helps.
Follow-up Edit:
Here's a way to set up an interface.
Assuming that your set-up is similar to mine...
Sheet1:
Sheet2 (I jumbled the headers on purpose):
Interface Sheet:
Result after running code:
Here's the code. Modify accordingly and make sure your headers are exact.
Sub ModdedMap()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim HeadersOne As Range, HeadersTwo As Range
Dim hCell As Range
With ThisWorkbook
Set Sh1 = .Sheets("Sheet1") 'Modify as necessary.
Set Sh2 = .Sheets("Sheet2") 'Modify as necessary.
Set Sh3 = .Sheets("Interface") 'Modify as necessary.
End With
Set HeadersOne = Sh3.Range("A1:A" & Sh3.Range("A" & Rows.Count).End(xlUp).Row)
Application.ScreenUpdating = False
For Each hCell In HeadersOne
SCol = GetColMatched(Sh1, hCell.Value)
TCol = GetColMatched(Sh2, hCell.Offset(0, 1).Value)
LRow = GetLastRowMatched(Sh1, hCell.Value)
For Iter = 2 To LRow
Sh2.Cells(Iter, TCol).Value = Sh1.Cells(Iter, SCol).Value
Next Iter
Next hCell
Application.ScreenUpdating = True
End Sub
Function GetLastRowMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetLastRowMatched = Sh.Cells(Rows.Count, ColIndex).End(xlUp).Row
End Function
Function GetColMatched(Sh As Worksheet, Header As String) As Long
ColIndex = Application.Match(Header, Sh.Rows(1), 0)
GetColMatched = ColIndex
End Function
There's no need in this situation to copy the cells one at a time. Not for any performance reason (unless you have tons and tons of data you probably wouldn't run into any performance issues) - it's just that the code would be simpler if you copied the columns directly from Sheet1 to Sheet2 in one operation per column.
The first step is to identify how many rows total are in Sheet1 that you want to copy. There are many schools of thought on how to obtain a used row count in Excel, but the simplest is probably to use the expression UsedRange.Rows.Count on the worksheet (we subtract 1 because we're not copying the header row):
Dim row_count As Long
row_count = Sheets("Sheet1").UsedRange.Rows.Count - 1
Range("Sheet1!A2").Resize(row_count).Copy Range("Sheet2!C2")
Range("Sheet1!B2").Resize(row_count).Copy Range("Sheet2!A2")
Range("Sheet1!C2").Resize(row_count).Copy Range("Sheet2!B2")
I would be satisfied doing it this way, with one line per column that you want to copy. There's still duplicated code, but it's manageable in my opinion.