Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all 50061 articles
Browse latest View live

Problems getting a column width changed in multiple sheets at the same time.

$
0
0
I have tried the following to change column "BL" in multiple sheets at the same time and it is the only thing that doesn't seem to happen. Every other action in the macro performs correctly except the column width. It appears to change Period 1 but then leaves the rest alone. Where am I going wrong? p.s no error comes up.

Sub unprotect_all_2()

For Each wsheet In Worksheets
wsheet.Unprotect
Next wsheet

Sheets(Array("Period 1", "Period 2", "Period 3", "Period 4", "Period 5", "Period 6", _
"Period 7", "Period 8", "Period 9", "Period 10", "Period 11", "Period 12", _
"Additional Checks")).Select

Range("BL2").Select

ActiveCell.FormulaR1C1 = "Has the appropriate contact been made and is the content of any correspondence sent clear and accurate whilst covering all relevant points/answering all questions (inc. spelling/grammar)"
Range("bw5").Select
ActiveCell.FormulaR1C1 = "Safeguarding"
Range("BW2").Select
ActiveCell.FormulaR1C1 = "1"
Range("BX2").Select
ActiveCell.FormulaR1C1 = "2"
Range("BY2").Select
ActiveCell.FormulaR1C1 = "3"
Range("BZ2").Select
ActiveCell.FormulaR1C1 = "4"
Range("CA2").Select
ActiveCell.FormulaR1C1 = "5"

Sheets(Array("Period 1", "Period 2", "Period 3", "Period 4", "Period 5", "Period 6", _
"Period 7", "Period 8", "Period 9", "Period 10", "Period 11", "Period 12", _
"Additional Checks")).Select
Sheets("period 1").activate
columns("bl:bl").columnwidth = 14.86

Sheets("Year to date").Select
Range("AA3").Value = "Safeguarding"
For Each wsheet In Worksheets
wsheet.Protect
Next wsheet

End Sub

In the end and in order to get it to work I've had to resort to the following script. Can anyone tell me what I'm doing wrong in the first script?

Sub unprotect_all()
For Each wsheet In Worksheets
wsheet.Unprotect
Next wsheet
Sheets(Array("Period 1", "Period 2", "Period 3", "Period 4", "Period 5", "Period 6", _
"Period 7", "Period 8", "Period 9", "Period 10", "Period 11", "Period 12", _
"Additional Checks")).Select

Range("BL2").Select

ActiveCell.FormulaR1C1 = "Has the appropriate contact been made and is the content of any correspondence sent clear and accurate whilst covering all relevant points/answering all questions (inc. spelling/grammar)"
Range("bw5").Select
ActiveCell.FormulaR1C1 = "Safeguarding"
Range("BW2").Select
ActiveCell.FormulaR1C1 = "1"
Range("BX2").Select
ActiveCell.FormulaR1C1 = "2"
Range("BY2").Select
ActiveCell.FormulaR1C1 = "3"
Range("BZ2").Select
ActiveCell.FormulaR1C1 = "4"
Range("CA2").Select
ActiveCell.FormulaR1C1 = "5"

Sheets("period 1").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("period 2").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("period 3").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("period 4").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("period 5").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("period 6").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("period 7").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("period 8").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("period 9").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("period 10").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("period 11").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("period 12").Select
Columns("bl:bl").ColumnWidth = 14.86
Sheets("additional checks").Select
Columns("bl:bl").ColumnWidth = 14.86


Sheets("Year to date").Select
Range("AA3").Value = "Safeguarding"
For Each wsheet In Worksheets
wsheet.Protect
Next wsheet

End Sub

updating multiple tabs with a workbook

$
0
0
Hi there

We run a master spreadsheet tab containing details of a number of events that we produce, I then use some of the same information on two different tabs within the same workbook with more specific event and compliance information.

The master sheet runs in ascending date order, newly confirmed events are added into the time line by inserting a new row then the appropriate info, I'm looking for a macro/vba to enable me to up date the update the additional tabs following an update to the master while maintaining the timeline...

Any help would be greatly appreciated.

Thanks in advance!

.FormulaArray =

$
0
0
Having problems getting an array formula to work and can't work out why. Can anyone help?

#With ThisWorkbook.Sheets("Sheet1").Range
Range.("H2").FormulaArray = "=INDEX($G$2:$G$10,MATCH(1,(A2=$E$2:$D$10)*(B2=$C$2:$E$10),0))"
Range.(H2:H10").Select
Selection.FillDown
Range.(H2:H10").Value = Range.(H2:H10").Value2
end with#

I keep asking but don't get a response, how do I put the code in the right format?

Allow a user to change a password

$
0
0
I have developed a workbook which prevents users accessing various elements without entering a password. At present the workbook is protected on 3 levels as follows:

VBA - protected with "password1"
Sheet level - protected with "password2"
User elements - protected with "password3" to "password7" ie 5 different users with 5 different passwords so they can only access their part of the workbook.

What I would like to do would be to allow the user to change "password3" to "password7" using an input box or something similar.

Thanks in advance for your help.

Filter/delete rows based on data from different sheet?

$
0
0
Hello,

Is it possible to filter data on Sheet1 (or delete rows), based on data in a column on Sheet2?

Every day I have to import a file into my workbook, after going through it manually to delete rows.
Sheet2 holds the names of our Operations team and the file I get everyday holds every name in the company..

Regards,

RR

Run macro if computer is idle

$
0
0
Hi,

I have a table that should refresh as often as possible (ideally once/hour).
The problem is that the table is big and it takes time to refresh and this disturbs my work (I'm working in the same file), so I cant't use the "Refresh every x minutes" native function of Excel.

What I want is to have a macro that tries to refresh the table every hour, but only if there is no activity on the file and if there is activity, to refresh it once Excel is idle for 1 minute (ie, when I go to the bathroom :)).
So, at 12:00 it should check if Excel is in use (I type something or select cells):
- if Excel is not in use, then it should refresh the table
- if Excel is in use, then it should wait and check when Excel is idle for 1 minute and then refresh

Is there a way I can achieve this?
Thank you.

Dropdownlist loop copy paste

$
0
0
Hi Guys

I am a beginner with vb and wondering if somebody can help.

I have source workbook with dropdowllist in B3 sheet name "Front Sheet", the list is based on data from another sheet in same workbook. I also have destination macro-enabled workbook "Combined", from here I like to run my vb.

What I am trying to achieve is to be able to loop through the DDL in source file front sheet, read the first code from DDL set that as range, update the data (data range B1:K50) in front sheet, copy this range and paste it to the Combined workbook on new sheet fronm A1 and rename this new sheet as the value from the source file Front Sheet B3 value.

I have managed the below below which runs, HOWEVER, it seems like its not changing the code in B3 hence not updating the range on Front Sheet workbook. Please can someone help:

Sub mytset()

Dim SourceWB As Workbook, DestWB As Workbook
Dim SourceSht As Worksheet, DestSht As Worksheet
Dim c As Range, myListRng As Range
Dim myListStr As String, myShtStr As String, myRngStr As String

' Initial
Set SourceWB = Workbooks("Refurbs Tracker") ' <~~ Use your Source Workbook name - "Refurbs Tracker" ?
Set DestWB = Workbooks("Combined") ' <~~ Use your Destination Workbook name - "Combined" ?
Set SourceSht = SourceWB.Worksheets("Front Sheet") ' <~~ Use your Source Sheet name - "Front Sheet" ?

' find the drop down values
If SourceSht.Range("B3").Validation.Type = xlValidateList Then
myListStr = Mid(SourceSht.Range("B3").Validation.Formula1, 2)
On Error Resume Next
Set myListRng = SourceWB.Names(myListStr).RefersToRange
If Err.Number <> 0 Then
myShtStr = Left(myListStr, InStr(1, myListStr, "!") - 1)
myRngStr = Right(myListStr, Len(myListStr) - Len(myShtStr) - 1)
myShtStr = Replace(myShtStr, "'", "")
Set myListRng = SourceWB.Worksheets(myShtStr).Range(myRngStr)
End If
On Error GoTo 0
Else
MsgBox "Problem with Validation List"
Exit Sub
End If

' loop through the drop down values and do work
For Each c In myListRng
If SheetExists(c.Value, DestWB) Then
Set DestSht = DestWB.Worksheets(c.Value)
Else
Set DestSht = DestWB.Worksheets.Add
DestSht.Name = c.Value
End If
SourceSht.Range("B1:K50").Copy
DestSht.Range("A1").PasteSpecial PASTE:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Next c
Application.CutCopyMode = False

' Clean up
Set SourceSht = Nothing
Set DestSht = Nothing
Set SourceWB = Nothing
Set DestWB = Nothing

End Sub




Function SheetExists(Name As String, WB As Workbook) As Boolean
Dim WS As Worksheet
SheetExists = False
For Each WS In WB.Worksheets
If Name = WS.Name Then
SheetExists = True
GoTo CleanUp:
End If
Next WS
CleanUp:
Set WS = Nothing
End Function

How to replace drop down list filter to those normal excel filter?

$
0
0
Hi,

I just want to ask how can I replace the drop down list (from the data navigation function) to the normal excel data filter?

Attached the screenshot, that hopefully makes everyone understood.

I found the data validation drop down list are not user friendly, especially when I got more than 100 items to filter.
The normal data filter will give us option to search, or filter by typing the item code.
The data validation drop down list have to scroll one by one, ups and down in order to look for the item code.
I'm using the data validation to create a graph so that it can reflect the data whenever I select different item code.

Any idea how can I improvise this...?

I don't know if this needs macro coding, which is why I posted over here..
I'm assuming that it has to be via macro coding.
I'm absolutely know nothing about macro, hence, please bear with me my stupidity on this.


Please help, as I try to google, but it seems google don't understand what I'm looking for... :'(

Thanks

Regards
cks1026

Macro to replace values in Excel taking from user input.

$
0
0
Hi guys,

I have a requirement in my project please help.

Requirement:
excel.PNG

i have an userform taking input file and two buttons one is "add another" and second one is "OK". If give the first file it should replace file1 in inserted file in excel and if inserted second file by clicking add another button it should replace file2 in excel and so on. and at the end it should also displays how many files i gave in the input.

Thanks
sai.

Worksheet Macro Error When Running Workbook Macro

$
0
0
Excel 2011 on Mac, OSX

Run-time error '13' Type mismatch

Trying to run a macro located in "This Workbook," but get interrupted with an error in the below macro located in the "Worksheet." The line .Value = UCase(.Value) is highlighted yellow with a yellow arrow to the left. The worksheet macro works okay when not trying to run the workbook macro - converts all text to upper case. What is wrong here?

Code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
    If Not .HasFormula Then
        .Value = UCase(.Value)
    End If
End With
End Sub

how to record every change in a workbook?

$
0
0
for every changes in all worksheet of a workbook like delete, copy, paste & text or number input, all these can be recorded in a new sheet.
and how to record these?:(

Would like to add an up/down button that scrools up/down when clicked.

$
0
0
Hi

I am pretty new to macros so please forgive me if this is a stupid question. I am creating a datasheet for a conference that will be seen on a touchscreen monitor, and I would like it to be such that someone can walk up to the monitor and scroll up or down easily, so I figured perhaps an up button and a down button would work. Can anyone tell me how to do this? Also is there a was to do this so that the buttons stay on screen while scrolling?

Thanks,
Crash

Would like to add an up/down button that scrolls up/down when clicked.

$
0
0
Hi

I am pretty new to macros so please forgive me if this is a stupid question. I am creating a datasheet for a conference that will be seen on a touchscreen monitor, and I would like it to be such that someone can walk up to the monitor and scroll up or down easily, so I figured perhaps an up button and a down button would work. Can anyone tell me how to do this? Also is there a was to do this so that the buttons stay on screen while scrolling?

Thanks,
Crash

Looping Through Userform Controls

$
0
0
Hello again:
I am currently using the following macro to calculate the cost of a recipe entered using a userform (frmRecipeBox) and then storing the information in tblRecipes on Sheets("Recipe Box"). My question is this, is it possible to reduce the amount of code by using a loop? I have played around with somethings and did a lot of searching but can't find amything that works for me. Again, I am very new at all this and learning as I go. I actually need to calculate the cost of 15 ingredients making the code almost 3 times the amount however that is too much text to post here. I am afraid that so much code will invite trouble at some point.
Code:

Sub CalculateRecipeCost()
Set MyRange = Sheets("Inventory").Range("tblProducts") 'data range

'Calculate the cost of ingredient 1
Dim myAmt1 As String, myIng1 As String, myUnit1 As String

myAmt1 = frmRecipeBox.rec5.Value 'quantity
myIng1 = frmRecipeBox.rec4.Value 'ingredient
myUnit1 = frmRecipeBox.rec6.Value 'unit



If myAmt1 = vbNullString Then
frmRecipeBox.Cost1 = 0
Else
    If myUnit1 = "Kilograms" Then
frmRecipeBox.Cost1 = Application.WorksheetFunction.VLookup(myIng1, MyRange, 17, 0) * myAmt1
Else
    If myUnit1 = "Grams" Then
frmRecipeBox.Cost1 = Application.WorksheetFunction.VLookup(myIng1, MyRange, 18, 0) * myAmt1
 Else
    If myUnit1 = "Pounds" Then
frmRecipeBox.Cost1 = Application.WorksheetFunction.VLookup(myIng1, MyRange, 19, 0) * myAmt1
Else
    If myUnit1 = "Ounces Dry" Then
frmRecipeBox.Cost1 = Application.WorksheetFunction.VLookup(myIng1, MyRange, 20, 0) * myAmt1
Else
    If myUnit1 = "Liter" Then
frmRecipeBox.Cost1 = Application.WorksheetFunction.VLookup(myIng1, MyRange, 21, 0) * myAmt1
Else
    If myUnit1 = "Mils" Then
frmRecipeBox.Cost1 = Application.WorksheetFunction.VLookup(myIng1, MyRange, 22, 0) * myAmt1
 Else
    If myUnit1 = "Each" Then
frmRecipeBox.Cost1 = Application.WorksheetFunction.VLookup(myIng1, MyRange, 23, 0) * myAmt1
 Else
    If myUnit1 = "Ounces Liquid" Then
frmRecipeBox.Cost1 = Application.WorksheetFunction.VLookup(myIng1, MyRange, 24, 0) * myAmt1
End If
End If
End If
End If
End If
End If
End If
End If
End If

'Calculate the cost of ingredient 2
Dim myAmt2 As String, myIng2 As String, myUnit2 As String

myAmt2 = frmRecipeBox.rec9.Value 'quantity
myIng2 = frmRecipeBox.rec8.Value 'ingredient
myUnit2 = frmRecipeBox.rec10.Value 'unit


If myAmt2 = vbNullString Then
frmRecipeBox.Cost2 = 0
Else
    If myUnit2 = "Kilograms" Then
frmRecipeBox.Cost2 = Application.WorksheetFunction.VLookup(myIng2, MyRange, 17, 0) * myAmt2
Else
    If myUnit2 = "Grams" Then
frmRecipeBox.Cost2 = Application.WorksheetFunction.VLookup(myIng2, MyRange, 18, 0) * myAmt2
 Else
    If myUnit2 = "Pounds" Then
frmRecipeBox.Cost2 = Application.WorksheetFunction.VLookup(myIng2, MyRange, 19, 0) * myAmt2
Else
    If myUnit2 = "Ounces Dry" Then
frmRecipeBox.Cost2 = Application.WorksheetFunction.VLookup(myIng2, MyRange, 20, 0) * myAmt2
Else
    If myUnit2 = "Liter" Then
frmRecipeBox.Cost2 = Application.WorksheetFunction.VLookup(myIng2, MyRange, 21, 0) * myAmt2
Else
    If myUnit2 = "Mils" Then
frmRecipeBox.Cost2 = Application.WorksheetFunction.VLookup(myIng2, MyRange, 22, 0) * myAmt2
 Else
    If myUnit2 = "Each" Then
frmRecipeBox.Cost2 = Application.WorksheetFunction.VLookup(myIng2, MyRange, 23, 0) * myAmt2
 Else
    If myUnit2 = "Ounces Liquid" Then
frmRecipeBox.Cost2 = Application.WorksheetFunction.VLookup(myIng2, MyRange, 24, 0) * myAmt2
End If
End If
End If
End If
End If
End If
End If
End If
End If

'Calculate the cost of ingredient 3
Dim myAmt3 As String, myIng3 As String, myUnit3 As String

myAmt3 = frmRecipeBox.rec13.Value 'quantity
myIng3 = frmRecipeBox.rec12.Value 'ingredient
myUnit3 = frmRecipeBox.rec14.Value 'unit


If myAmt3 = vbNullString Then
frmRecipeBox.Cost3 = 0
Else
    If myUnit3 = "Kilograms" Then
frmRecipeBox.Cost3 = Application.WorksheetFunction.VLookup(myIng3, MyRange, 17, 0) * myAmt3
Else
    If myUnit3 = "Grams" Then
frmRecipeBox.Cost3 = Application.WorksheetFunction.VLookup(myIng3, MyRange, 18, 0) * myAmt3
 Else
    If myUnit3 = "Pounds" Then
frmRecipeBox.Cost3 = Application.WorksheetFunction.VLookup(myIng3, MyRange, 19, 0) * myAmt3
Else
    If myUnit3 = "Ounces Dry" Then
frmRecipeBox.Cost3 = Application.WorksheetFunction.VLookup(myIng3, MyRange, 20, 0) * myAmt3
Else
    If myUnit3 = "Liter" Then
frmRecipeBox.Cost3 = Application.WorksheetFunction.VLookup(myIng3, MyRange, 21, 0) * myAmt3
Else
    If myUnit3 = "Mils" Then
frmRecipeBox.Cost3 = Application.WorksheetFunction.VLookup(myIng3, MyRange, 22, 0) * myAmt3
 Else
    If myUnit3 = "Each" Then
frmRecipeBox.Cost3 = Application.WorksheetFunction.VLookup(myIng3, MyRange, 23, 0) * myAmt3
 Else
    If myUnit3 = "Ounces Liquid" Then
frmRecipeBox.Cost3 = Application.WorksheetFunction.VLookup(myIng3, MyRange, 24, 0) * myAmt3
End If
End If
End If
End If
End If
End If
End If
End If
End If

'Calculate the cost of ingredient 4
Dim myAmt4 As String, myIng4 As String, myUnit4 As String

myAmt4 = frmRecipeBox.rec17.Value 'quantity
myIng4 = frmRecipeBox.rec16.Value 'ingredient
myUnit4 = frmRecipeBox.rec18.Value 'unit


If myAmt4 = vbNullString Then
frmRecipeBox.Cost4 = 0
Else
    If myUnit4 = "Kilograms" Then
frmRecipeBox.Cost4 = Application.WorksheetFunction.VLookup(myIng4, MyRange, 17, 0) * myAmt4
Else
    If myUnit4 = "Grams" Then
frmRecipeBox.Cost4 = Application.WorksheetFunction.VLookup(myIng4, MyRange, 18, 0) * myAmt4
 Else
    If myUnit4 = "Pounds" Then
frmRecipeBox.Cost4 = Application.WorksheetFunction.VLookup(myIng4, MyRange, 19, 0) * myAmt4
Else
    If myUnit4 = "Ounces Dry" Then
frmRecipeBox.Cost4 = Application.WorksheetFunction.VLookup(myIng4, MyRange, 20, 0) * myAmt4
Else
    If myUnit4 = "Liters" Then
frmRecipeBox.Cost4 = Application.WorksheetFunction.VLookup(myIng4, MyRange, 21, 0) * myAmt4
Else
    If myUnit4 = "Mils" Then
frmRecipeBox.Cost4 = Application.WorksheetFunction.VLookup(myIng4, MyRange, 22, 0) * myAmt4
 Else
    If myUnit4 = "Each" Then
frmRecipeBox.Cost4 = Application.WorksheetFunction.VLookup(myIng4, MyRange, 23, 0) * myAmt4
 Else
    If myUnit4 = "Ounces Liquid" Then
frmRecipeBox.Cost4 = Application.WorksheetFunction.VLookup(myIng4, MyRange, 24, 0) * myAmt4
End If
End If
End If
End If
End If
End If
End If
End If
End If


'Calculate the cost of ingredient 5
Dim myAmt5 As String, myIng5 As String, myUnit5 As String

myAmt5 = frmRecipeBox.rec21.Value 'quantity
myIng5 = frmRecipeBox.rec20.Value 'ingredient
myUnit5 = frmRecipeBox.rec22.Value 'unit


If myAmt5 = vbNullString Then
frmRecipeBox.Cost5 = 0
Else
    If myUnit5 = "Kilograms" Then
frmRecipeBox.Cost5 = Application.WorksheetFunction.VLookup(myIng5, MyRange, 17, 0) * myAmt5
Else
    If myUnit5 = "Grams" Then
frmRecipeBox.Cost5 = Application.WorksheetFunction.VLookup(myIng5, MyRange, 18, 0) * myAmt5
 Else
    If myUnit5 = "Pounds" Then
frmRecipeBox.Cost5 = Application.WorksheetFunction.VLookup(myIng5, MyRange, 19, 0) * myAmt5
Else
    If myUnit5 = "Ounces Dry" Then
frmRecipeBox.Cost5 = Application.WorksheetFunction.VLookup(myIng5, MyRange, 20, 0) * myAmt5
Else
    If myUnit5 = "Liter" Then
frmRecipeBox.Cost5 = Application.WorksheetFunction.VLookup(myIng5, MyRange, 21, 0) * myAmt5
Else
    If myUnit5 = "Mils" Then
frmRecipeBox.Cost5 = Application.WorksheetFunction.VLookup(myIng5, MyRange, 22, 0) * myAmt5
 Else
    If myUnit5 = "Each" Then
frmRecipeBox.Cost5 = Application.WorksheetFunction.VLookup(myIng5, MyRange, 23, 0) * myAmt5
 Else
    If myUnit5 = "Ounces Liquid" Then
frmRecipeBox.Cost5 = Application.WorksheetFunction.VLookup(myIng5, MyRange, 24, 0) * myAmt5
End If
End If
End If
End If
End If
End If
End If
End If
End If

'Add the 5 ingredient amounts together for total recipe cost

frmRecipeBox.rec65.Value = Format(Val(Replace(frmRecipeBox.Cost1.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost2.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost3.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost4.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost5.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost6.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost7.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost8.Value, ",", "")) + _
  Val(Replace(frmRecipeBox.Cost9.Value, ",", "")) + _
  Val(Replace(frmRecipeBox.Cost10.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost11.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost12.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost13.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost14.Value, ",", "")) + _
    Val(Replace(frmRecipeBox.Cost15.Value, ",", "")))
End Sub

Subtraction and check macro

$
0
0
Hello All,

I am new to Excel vba and I hope I can get some direction with a macro. It would automatically subtract column y (spacesWithinLots) from column x (lotTotal) and create a new balance of available lots (newBal).The macro would check to if the newBal is less than 0. If it is then it would add the next lotTotal to the newBal and continue subtracting - newBal less spacesWithinLots.

As it shows (below) the first calc is with the newBal resulting from the lotTotal - spacesWithinLots. The next step involves checking to see if the newBal is less than 0 and then adding the next value of the lotTotal to the newBal, otherwise the newBal column would continue to subtract from the spacesWithinLots column and offset the newBal once cell below.

Example:

lotTotal l spacesWithinLots l newBal
20 4 16
10 9 7
11 -4(+10) <----This is less than 0 so the next value in the lotTotal is added to the newBal and the subtraction continues.
3 3

Here is my code. I cant get the macro to add the next lotTotal amount when the newBal equals 0 or less.

Sub LotCalc()

Dim spacesWithinLots, lotTotal, newBal As Single

Dim i As Integer
Dim j As Integer

lotTotal = Cells(4, 4).Value
spacesWithinLots = Cells(4, 7).Value
newBal = Cells(i, 8).Value


Sheets("Remaining Lots").Select
Range("H4").Select

i = 4
j = 8

ActiveCell.Value = Cells(i, 4) - Cells(i, 7)

Do While Cells(i, 7) > "0"

ActiveCell.Offset(1, 0).Select
ActiveCell.Value = Cells(i, 8) - Cells(i + 1, 7)

i = i + 1

Loop

End Sub

Any help will be appreciated.

Thanks,

If statements in VBA to look at multiple criteria without a nested formula

$
0
0
Hi,

I would like to write in VBA a list to advise IF contains this then return this for a number of outcomes. I have seen in the past this used to look for postcodes and then using the formula bar you can reference the code to check a cell rather than nesting IF statements.

Basically I want to check if cell contains APP then return APP, Else IF cell contains CARD then return CARD etc etc.

In excel I'd then just input

=(subname(CELL))

Thanks

[SOLVED] Add string as formula through code doesn't work with sumif

$
0
0
Hi,

I need to add a FX rate calculation to a number of (selected) cells which already contains values.

With only one FX rate it worked selecting a few suitable cells and executing the following macro:
Code:

Sub addToFormula()
    Dim rng As Range
    Dim tempRng As Range
    Dim nbrofprop As Range
   
    Set rng = Selection
    nbrofrows = rng.Rows.Count
    nbrofcols = rng.Columns.Count
    For i = 1 To nbrofrows
        For j = 1 To nbrofcols
            Set tempRng = rng.Cells(i, j)
            formulaAdd = "=1/'Sheet 1'!$D$5*" & tempRng.Formula
            tempRng.Formula = formulaAdd
        Next j
    Next i
End Sub

However, when I want to have different FX rates for different assets and have a more "intelligent" formula using the following code:
Code:

Sub addToFormula()
    Dim rng As Range
    Dim tempRng As Range
    Dim nbrofprop As Range
   
    Set rng = Selection
    nbrofrows = rng.Rows.Count
    nbrofcols = rng.Columns.Count
    For i = 1 To nbrofrows
        For j = 1 To nbrofcols
            Set tempRng = rng.Cells(i, j)
            currentRow = ActiveCell.Row
            formulaAdd = "=1/SUMIF('Sheet 1'!$C$4:$C$100;C" & currentRow & ";'Sheet 1'!$D$4:$D$100)*" & tempRng.Formula
            tempRng.Formula = formulaAdd
        Next j
    Next i
End Sub

I get "Run-time error '1004': Application-defined or object defined error" for the formulaAdd row. The code works fine if I remove the equal sign before "1/SUMIF(..." (but then obviously the end result is not a formula and I would have to manually add an equal sign..). Any ideas why this happens or how I can solve this problem?

I have attached an example file with the code mentioned here. The column which should be converted is the "E" column in the sheet "Sheet 2".

For the record - yes it would be simple to just have a "local currency" column and a "FX adjusted column" but it wouldn't work for the real application in this case.
Attached Files

Highlight leading and trailing spaces of text within cells

$
0
0
I need a macro that will highlight (in yellow) the spaces within a cell that lead or trail a string of text. The spaces between the words or values should not be highlighted. Also, I am not wanting to color the entire cell. I would like to run the macro for all cells in a worksheet.

Any thoughts?

copy paste loop

$
0
0
Hi Guys

I am a beginner with vb and wondering if somebody can help.

I have source workbook with dropdowllist in B3 sheet name "Front Sheet", the list is based on data from another sheet in same workbook. I also have destination macro-enabled workbook "Combined", from here I like to run my vb.

What I am trying to achieve is to be able to loop through the DDL in source file front sheet, read the first code from DDL set that as range, update the data (data range B1:K50) in front sheet, copy this range and paste it to the Combined workbook on new sheet fronm A1 and rename this new sheet as the value from the source file Front Sheet B3 value.

I have managed the below below which runs, HOWEVER, it seems like its not changing the code in B3 hence not updating the range on Front Sheet workbook. Please can someone help:

Sub mytset()

Dim SourceWB As Workbook, DestWB As Workbook
Dim SourceSht As Worksheet, DestSht As Worksheet
Dim c As Range, myListRng As Range
Dim myListStr As String, myShtStr As String, myRngStr As String

' Initial
Set SourceWB = Workbooks("Refurbs Tracker") ' <~~ Use your Source Workbook name - "Refurbs Tracker" ?
Set DestWB = Workbooks("Combined") ' <~~ Use your Destination Workbook name - "Combined" ?
Set SourceSht = SourceWB.Worksheets("Front Sheet") ' <~~ Use your Source Sheet name - "Front Sheet" ?

' find the drop down values
If SourceSht.Range("B3").Validation.Type = xlValidateList Then
myListStr = Mid(SourceSht.Range("B3").Validation.Formula1, 2)
On Error Resume Next
Set myListRng = SourceWB.Names(myListStr).RefersToRange
If Err.Number <> 0 Then
myShtStr = Left(myListStr, InStr(1, myListStr, "!") - 1)
myRngStr = Right(myListStr, Len(myListStr) - Len(myShtStr) - 1)
myShtStr = Replace(myShtStr, "'", "")
Set myListRng = SourceWB.Worksheets(myShtStr).Range(myRngStr)
End If
On Error GoTo 0
Else
MsgBox "Problem with Validation List"
Exit Sub
End If

' loop through the drop down values and do work
For Each c In myListRng
If SheetExists(c.Value, DestWB) Then
Set DestSht = DestWB.Worksheets(c.Value)
Else
Set DestSht = DestWB.Worksheets.Add
DestSht.Name = c.Value
End If
SourceSht.Range("B1:K50").Copy
DestSht.Range("A1").PasteSpecial PASTE:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Next c
Application.CutCopyMode = False

' Clean up
Set SourceSht = Nothing
Set DestSht = Nothing
Set SourceWB = Nothing
Set DestWB = Nothing

End Sub




Function SheetExists(Name As String, WB As Workbook) As Boolean
Dim WS As Worksheet
SheetExists = False
For Each WS In WB.Worksheets
If Name = WS.Name Then
SheetExists = True
GoTo CleanUp:
End If
Next WS
CleanUp:
Set WS = Nothing
End Function

assigning numerical values to a drop down list

$
0
0
hi

l'm new here and l hope you can help me....

l have some survey results that l want to enter in a spreadsheet. l have created two (2) drop down list, one named RESULTS containing these values; positive,negative,no sample and invalid. the other drop down list named TYPES contains these values Malaria, TB, Schisto and AIDS. l want to assign values to the drop down list e.g positive = 1, Negative = 0, no sample= 2, invalid = 3.....malaria=1, tb=2, schisto=3, aids=4. l want the drop down list to reflect the numerical value rather than the words in the same cell of the drop down list. also when l select 1 (for positive) the drop down list (TYPES) on the next cell should give me the option to choose from 1-4 (the numerical values of the diseases), however if l choose 0,2 or 3 on the drop down list RESULTS l want the drop down list TYPE not to respond.
l hope this is possible

thank you in advance
Viewing all 50061 articles
Browse latest View live