Sub Goal Seek()
Dim i As Integer
Dim ResultQty As Integer
Dim ChangingCell As Integer
Dim TargetSales As Integer
For i = 4 To 18
TargetSales = Cells(i,7).value
Cells(i, 6).Formula = "(C" & i & "*" & "E" & i & ")"
Set ResultQty = Cells(i,6).value
Set ChangingCell = Cells(i,3).value
ResultCell.GoalSeek TargetSales, ChangingCell
Next i
End Sub
I want to get the Qty from goal seeker by setting the targeted sales. But the code shows error. Can anyone help with it?
'=' missing in formula cell, target cell should not be integer as values are higher than range allowed
Sub GoalSeek()
Dim i As Integer
Dim ResultCell As Range
Dim TargetSales As Variant
For i = 4 To 18
Set ResultCell = Cells(i, 3)
TargetSales = Cells(i, 7).Value
Set ResultCell = Cells(i, 6)
ResultCell.Formula = "=(C" & i & "*" & "E" & i & ")"
ResultCell.GoalSeek TargetSales, Range("C" & i)
Next i
End Sub
Related
I'm writing a macro to concatenate a few columns into another column for a sheet that will eventually have thousands of rows. For the sake of testing I'm using four rows of data. My issue is that the Cells(i,25).Value is not populating when I run the following code. The code isn't breaking and I'm not getting any error messages. I tried assigning a 2 to column 26 using Cells(i,26) and that wasn't working either.
Sub concat()
Dim i As Long
Dim add As String
i = 1
Do Until IsEmpty(Cells(i, 1))
add = Cells(i, 14).Value
Cells(i, 25).Value = Cells(i, 1).Value & " " & Cells(i, 2).Value & " " & Left(add, 3)
i = i + 1
Loop
End Sub
Any help or recommendations would be greatly appreciated!
I recommend you change the code a little. I have used the IsEmpty command before and it's not the most suitable one for this.
Sub concat()
Dim i As Long
Dim add As String
Dim last_1 As Long
Dim last_2 As Long
Dim last_14 As Long
Dim lastCell As Long
last_1 = Sheets("test3").Cells(Rows.Count, 1).End(xlUp).Row
last_2 = Sheets("test3").Cells(Rows.Count, 2).End(xlUp).Row
last_14 = Sheets("test3").Cells(Rows.Count, 14).End(xlUp).Row
lastCell = WorksheetFunction.Max(last_1 , last_2, last_14)
For i = 1 To lastCell
add = Sheets("test3").Cells(i, 14).Value
Sheets("test3").Cells(i, 25).Value = Sheets("test3").Cells(i, 1).Value & " " & Sheets("test3").Cells(i, 2).Value & " " & Left(add, 3)
Next i
End Sub
I am trying to identify a specific range in column-A and concatenate two cells within the specific range and delete the empty cell. I have been successful in putting a code together and it does the job very well. But, I don't know how to loop it to identify next range. Any help would be appreciated.
As per below image and code, First, I am finding and selecting a range between two (MCS) in column-A with a condition that, if the rows are more than 8 between two MCS. Then I am concatenating first 2 cells immediately after MCS and delete the empty row.
The below code works well for first range but I am unable to loop to identify next range from row 22 to 32 and perform concatenations. I want to loop in column-A as there will be more MCS.
Sub MergeStem()
Dim findMCS1 As Long
Dim findMCS2 As Long
Dim myCount As Integer
Dim myStems As Long
Dim mySelect As Range
Dim c As Range
findMCS1 = Range("A:A").Find("MCS", Range("A1")).Row
findMCS2 = Range("A:A").Find("MCS", Range("A" & findMCS1)).Row
myCount = Range("A" & findMCS1 + 1 & ":A" & findMCS2 - 1).Cells.Count
Range("B1").Value = myCount
MsgBox "Number of rows =" & myCount
Set mySelect = Selection
If myCount > 8 Then
myStems = Range("A" & findMCS1 + 2 & ":A" & findMCS2 - 9).Select
Set mySelect = Selection
For Each c In mySelect.Cells
If firstcell = "" Then firstcell = c.Address(bRow, bCol)
sArgs = sArgs + c.Text + " "
c.Value = ""
Next
Range(firstcell).Value = sArgs
End If
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub
You could try:
Option Explicit
Sub test()
Dim i As Long, Lastrow As Long, Startpoint As Long, Endpoint As Long, Diff As Long
Dim str As String
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Startpoint = 0
Endpoint = 0
For i = Lastrow To 2 Step -1
str = .Range("A" & i).Value
If str = "MCS" And Startpoint = 0 Then
Startpoint = i
ElseIf str = "MCS" And Startpoint <> 0 Then
Endpoint = i
End If
If Startpoint > 0 And Endpoint > 0 Then
Diff = Startpoint - Endpoint
If Diff > 8 Then
.Range("A" & Endpoint + 1).Value = .Range("A" & Endpoint + 1).Value & " " & .Range("A" & Endpoint + 2).Value
.Rows(Endpoint + 2).EntireRow.Delete
Startpoint = 0
Endpoint = 0
End If
End If
Next i
End With
End Sub
I need to create a VBA script in excel that chanages an order number from having "CD" at the front to "CD" at the end so from "CD00001" to "00001CD"
Any help would be awesome. all of the order numbers are in Column B and start at row 5. please help.
What i have so far:
Private Sub OrderNumber_Click()
Dim Val As String
Dim EndC As Integer
EndC = Worksheets("Raw Data Upload").Range("A1048576").End(xlUp).Row
For i = 5 To EndC
Val = Right("B" & i, Len("B" & i) - 2) & Left("B" & i, 2)
Range("B" & i).Value = Val
Next
End Sub
This replaces the order numbers with B5, B6 and so on but if i put this function into Excel itself it works fine.
Like this? DO you want it in column B?
Option Explicit
Private Sub OrderNumber_Click()
Dim i As Long
Dim val As String
Dim EndC As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Raw Data Upload")
EndC = ws.Range("A1048576").End(xlUp).Row
For i = 5 To EndC
val = ws.Cells(i, "A")
Range("B" & i).Value = Mid$(val, 3, Len(val) - 2) & Left$(val, 2)
Next i
End Sub
dim beginStr, endStr, originalStr, outputStr as string
dim rng as range
'put the below into a loop, assigning a rng to the desired cell each time
originalStr = rng.value ' Change to chosen range
beginStr = left(originalStr,2)
endStr = right(originalStr, len(originalStr) - 2)
outputStr = endStr + beginStr
Range("B" & i).Value = outputStr
I haven't got a copy of Excel to test this on but it should work.
Simply use:
Right(Range("B" & i), Len(Range("B" & i)) - 2) & Left(Range("B" & i), 2)
An alternative is to set up the cell as a Range():
Sub t()
Dim cel As Range
Dim endC As Long
endC = Worksheets("Raw Data Upload").Range("A1048576").End(xlUp).Row
For i = 5 To endC
Set cel = Range("B" & i)
myVal = Right(cel, Len(cel) - 2) & Left(cel, 2)
Range("B" & i).Value = myVal
Next
End Sub
Currently, when you do Right("B" & i, Len("B" & i) - 2) & Left("B" & i, 2), for row 5, this becomes Right("B5", Len("B5") - 2) & Left("B5", 2) then this evaluates to simply:
Right("B5",0) & Left("B5",2), which is
[nothing] & B5, finally becoming
B5
Note the lack of using B5as a range. Instead it's being treated as a string.
(Also, I'm assuming this is to be run on the ActiveSheet. If not, please add the worksheet before the range, i.e. Worksheets("Raw Data Upload").Range("B" & i)...)
Try this
Private Sub OrderNumber_Click()
Dim cell As Range
With Worksheets("Raw Data Upload")
For Each cell in .Range("B5", .Cells(.Rows.Count, 2).End(xlUp))
cell.Value = Right(cell.Value, Len(cell.Value) - 2) & Left(cell.Value, 2)
Next
End With
End Sub
I'm building an master excel file that is designed to gather data from lots of other excel files that are stored in the business Dropbox files and place them in the 2nd sheet of the master file. I built a original version on my local computer and that worked perfectly (the path3 variable) but once I tried to convert it based on a changing file path (because each user will have a different path from their PC) I am getting the run time error. The formula defined by path2 is what I have been trying to use but even though the variable seems to be holding the right value (I tested it by having it write out the values) it doesn't seem to be able to move the data, throwing the above error and highlighting the "rngdest.Formula = Chr(61) & path2" line. I really don't have any idea what is causing this and I have spent several days trying different approaches but to no avail so any ideas, solutions or links to already solved (I have spent a long time searching but haven't found anything) would be very much appreciated.
I've included the whole of the code for completeness, I think I've removed most of the redundant code that I left in but there may be some still left. If you need any clarifications on the code please let me know. Thanks for any potential help
Private Sub CommandButton2_Click()
Dim counter As Integer
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim a As Integer
Dim z As Integer
Dim y As Integer
Dim p As Integer
Dim Names() As String
Dim Fix1() As String
Dim path3 As String
Dim path2 As String
Dim SheetName As String
Dim c As Range
Dim found As Range
Dim BookName As String
Dim var1 As String
Dim rngdest As Range
Dim rngsource As Range
Dim cell As String
Dim adjust As Integer
Dim adjust2 As Integer
Dim rngname As Range
Dim colNo As Integer
Dim fin As String
Dim fin2 As String
Dim fin3 As String
Dim comp As String
Dim teststring As String
Dim currentWb2 As Workbook
Set currentWb2 = ThisWorkbook
MsgBox "Excel will now update the sheet, please be patient as this can take a few minutes. You will be notified once it is complete"
ReDim Fix1(1 To 4)
Fix1(1) = "A-F"
Fix1(2) = "G-L"
Fix1(3) = "M-R"
Fix1(4) = "S-Z"
counter = 0
With ActiveSheet
i = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
ReDim Names(1 To i, 1 To 4)
With ActiveSheet
For k = 1 To 4
For a = 2 To i
Names(a, k) = Cells(a, k).Value
Next a
Next k
End With
SheetName = "Analysis"
BookName = "Outcomes Final.xlsm"
For p = 1 To 4
fin2 = Split(Cells(, p).Address, "$")(1)
With ActiveSheet
l = .Cells(.Rows.Count, fin2).End(xlUp).Row
End With
For z = 1 To l
counter = counter + 1
fin = Split(Cells(, counter).Address, "$")(1)
currentWb2.Sheets("Sheet2").Range("" & fin & "1") = Names(z, p)
For y = 1 To 34
adjust = y + 1
cell = "$B$" & y & ""
If z = 1 Then
Else
teststring = GetPath()
teststring = teststring & "\Clients\"
path3 = "'C:\Users\Lewis\Documents\Outcomes\Floating Support\Clients\" & Fix1(p) & "\" & Names(z, p) & "\[Outcomes Final.xlsm]Analysis'!" & cell & ""
path2 = teststring & Fix1(p) & "\" & Names(z, p) & "\Outcomes\[Outcomes Final.xlsm]Analysis'!" & cell & ""
End If
Set rngdest = currentWb2.Sheets("Sheet2").Range("" & fin & "" & adjust & "")
Set rngsource = Range("B" & y & "")
rngdest.Formula = Chr(61) & path2
Next y
Next z
Next p
currentWb2.Sheets("Sheet2").Columns(1).EntireColumn.Delete
currentWb2.Sheets("Sheet1").Range("A1:D35").Interior.ColorIndex = 0
For j = 1 To counter
fin3 = Split(Cells(, j).Address, "$")(1)
If currentWb2.Sheets("Sheet2").Range("" & fin3 & "35") = "1" Then
With currentWb2.Sheets("Sheet1").Range("A1:D35")
comp = currentWb2.Sheets("Sheet2").Range("" & fin3 & "1")
Set c = .Find(comp, LookIn:=xlValues)
If Not c Is Nothing Then
c.Interior.ColorIndex = 3
End If
End With
End If
Next j
MsgBox "The update is now complete, please click on sheet 2 to view the data. All clients in red have not been properly completed"
End Sub
I have a Sub I am writing that has a SUMIFS statement included in it. I am wanting the sum if to sum a certain column (yearRange.Offset(0,i+3)) when yearRange matches gEvent Value and yearRange.Offset(0, 2) matches gEvent.Offset(0,2) Value. I have tried googling the issue, and checked the MSDN website (which was not very descriptive) and cannot get the function to work. The only possible idea I have is that criteria I am using are Strings rather than Integers. So gEvent.Value may be "ABCD" and gEvent.Offset(0,2) may be "DEFG".
When I try to run the code it is breaking here:
itemPY = Application.WorksheetFunction.SumIfs(yearRange.Offset(0, i + 3), yearRange.Value, "=" & gEvent.Value & """, yearRange.Offset(0, 2), " = " & gEvent.Offset(0, 2).Value & """)
And the error I am receiving is:
Run-time error '424':
Object required
Here is the sub in it's complete form:
Sub CombineData()
Dim eventSheet As Worksheet
Dim yearSheet As Worksheet
Dim yearRange As Range
Dim eventRange As Range
Dim gYear As Range
Dim gEvent As Range
Dim i As Integer
Dim itemCount As Integer
Dim itemPY As Integer
Set eventSheet = ThisWorkbook.Sheets("previousEvent")
Set yearSheet = ThisWorkbook.Sheets("previous12")
Set eventRange = eventSheet.Range("A3", eventSheet.Range("A3").End(xlDown))
Set yearRange = yearSheet.Range("A4", yearSheet.Range("A4").End(xlDown))
For Each gEvent In eventRange
i = 0
gEvent.Offset(0, 16).Value = gEvent.Value
gEvent.Offset(0, 17).Value = gEvent.Offset(0, 1).Value
gEvent.Offset(0, 18).Value = gEvent.Offset(0, 2).Value
itemCount = Application.WorksheetFunction.CountIf(yearRange, gEvent.Value)
For i = 0 To 11
itemPY = Application.WorksheetFunction.SumIfs(yearRange.Offset(0, i + 3), yearRange.Value, "=" & gEvent.Value & """, yearRange.Offset(0, 2), " = " & gEvent.Offset(0, 2).Value & """)
gEvent.Offset(0, 19 + i).Value = itemPY / Item
Next i
Next gEvent
End Sub
Any help I could get would be great.
No need for all that quoting:
itemPY = Application.WorksheetFunction.SumIfs(yearRange.Offset(0, i + 3), _
yearRange, gEvent.Value, _
yearRange.Offset(0, 2), gEvent.Offset(0, 2).Value)